Tópicos relacionados a códigos VBA, gravação de macros, etc.
Por victor2 13 Fev 2019 às 01:47
Membro 1 Estrela
Mensagens: 24
Reputação: 0
#41164
Olá Senhores!

Bom, gostaria da ajuda dos senhores, por gentileza. Gostaria de linkar a atualização do mapa interativo da aba geral para as demais abas e manter a opção de clicar para destacar o quadrante conforme o exemplo no Exel. Realizei algumas tentativas mas não foram bem sucedidas. sempre falta algo.

Desde já agradeço novamente a ajuda!

At.de

Victor
Apenas usuários registrados podem ver ou baixar anexos.
Por babdallas 13 Fev 2019 às 11:06
Membro 5 Estrelas
Mensagens: 1310
Reputação: 602
#41169
Veja se é isso.
Apenas usuários registrados podem ver ou baixar anexos.
Por victor2 13 Fev 2019 às 13:23
Membro 1 Estrela
Mensagens: 24
Reputação: 0
#41178
Baddallas, era isso mesmo. Dentro do código que você me enviou, fiz outra alteração e dessa vez funcionou.

Código: Selecionar todosSub selecionarTL4()

    Dim strNomeForma    As String
    Dim rngCelulas      As Range
    Dim lngCor          As Long, lngRed As Long, lngGreen As Long, lngBlue As Long
    Dim wshPlan         As Worksheet
    Dim lobTabela       As ListObject
    Dim TL As String
    Set lobTabela = wshPrincipal.ListObjects("tbTipo")
    TL = ActiveSheet.Shapes(Application.Caller).Name
    shtDados.Range("selecionado").Value = TL
   
    For Each wshPlan In ThisWorkbook.Worksheets
        With wshPlan
            For Each rngCelulas In lobTabela.ListColumns("Tipo Cor").DataBodyRange
                strNomeForma = CStr(rngCelulas.Offset(, -1).Value2)
               
                lngCor = wshPrincipal.Range(rngCelulas.Value).Interior.Color
                lngRed = lngCor Mod 256
                lngGreen = (lngCor \ 256) Mod 256
                lngBlue = (lngCor \ 65536) Mod 256
               
                On Error Resume Next
                .Shapes.Range(strNomeForma).Fill.ForeColor.RGB = RGB(lngRed, lngGreen, lngBlue)
                On Error GoTo 0
                cDestaque = shtConfig.Range("CorDestaque").Interior.Color
                ActiveSheet.Shapes(TL).Fill.ForeColor.RGB = cDestaque
            Next rngCelulas
        End With
    Next wshPlan
   
End Sub


Muito obrigado