none
Mudar a cor da célula RRS feed

  • Pergunta

  • Surgiu agora uma nova necessidade dentro deste mesmo contexto:

    Preciso montar um quadro com várias linhas e colunas, onde eu quero realçar

    algumas células com cores, isto com apenas um clique em cada célula.

    Até aí o problema está resolvido.

    Pergunta 1: Seria possível repetir o conteúdo das células que foram preenchidas com apenas um clique

    em uma única linha?

    Pergunta 2: Seria possível que aquele código funcionasse apenas dentro de uma

    área específica da planilha? Ou seja, apenas dentro do quatro que eu criei?


    domingo, 25 de novembro de 2012 10:10

Respostas

  • Cole o código abaixo na classe da planilha que deseja obter o efeito:

    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
        Const CsIntervalo As String = "A1:F20"
        Const ClCor As Long = 65535 'Amarelo
        Const ClSemPreenchimento As Long = -4142
        
        Dim rCell As Range
        Dim sValue As String
        Dim rTarget As Range
        
        If Not Intersect(Target, Range(CsIntervalo)) Is Nothing Then
            Select Case Target.Address
                Case Rows(Target.Row).Address
                    For Each rCell In Intersect(Target, Range(CsIntervalo))
                        If rCell <> "" Then
                            sValue = rCell
                            Exit For
                        End If
                    Next rCell
                    If sValue <> "" Then
                        For Each rCell In Intersect(Target, Range(CsIntervalo)).Cells
                            If rCell.Interior.Color = ClCor Then
                                rCell = sValue
                            End If
                        Next rCell
                    End If
                    
                Case Else
                    With Target.Cells(1).Interior
                        If .ColorIndex = ClSemPreenchimento Then
                            .Color = ClCor
                        Else
                            .ColorIndex = ClSemPreenchimento
                        End If
                    End With
            End Select
        End If
    End Sub


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    domingo, 25 de novembro de 2012 12:29
    Moderador