Este fórum está sendo desativado

[victor2]

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

[babdallas]

Veja se é isso.

[victor2]

Baddallas, era isso mesmo. Dentro do código que você me enviou, fiz outra alteração e dessa vez funcionou.

Código: Selecionar todos

Sub 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