none
Mudar a cor da célula RRS feed

 > 

  • Pergunta

  • Question
    Entrar para Votar
    0
    Entrar para Votar

    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

  • Question
    Entrar para Votar
    0
    Entrar para Votar

    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