Este fórum está sendo desativado

[victor2]

Olá Mestres!

Bom gostaria de uma pequena ajuda de vocês para matar uma chara.

Estou criando um gráfico interativo que identifica cada quadrante com uma cor de acordo com a descrição dele.

Utilizei o código abaixo para realizar a tarefa,porém ao alterar os dados dos quadrantes do vetor para número, ele não reconhece mais. Como posso resolver esse problema?

Sub AtualizaMapa()

Dim testeAs Range

For Each testeIn Range("divisao")

cor = Cells(teste.Row, 6).Value
ActiveSheet.Shapes(teste).Fill.ForeColor.RGB = Range(cor).Interior.Color

Next teste


End Sub

Agradeço desde já a ajuda!

[babdallas]

Veja se atende.

Código: Selecionar todos

Public Sub PreencherCorFormas()
    Dim strNomeForma   As String
    Dim rngCelulas      As Range
    Dim lngCor As Long, lngRed As Long, lngGreen As Long, lngBlue As Long
    
    With wshPrincipal
        For Each rngCelulas In .ListObjects("tbTipo").ListColumns("Tipo Cor").DataBodyRange
            strNomeForma = CStr(rngCelulas.Offset(, -1).Value2)
            
            lngCor = .Range(rngCelulas.Value).Interior.Color
            lngRed = lngCor Mod 256
            lngGreen = (lngCor \ 256) Mod 256
            lngBlue = (lngCor \ 65536) Mod 256
            
            .Shapes.Range(strNomeForma).Fill.ForeColor.RGB = RGB(lngRed, lngGreen, lngBlue)
            
        Next rngCelulas
    End With
    
End Sub

[victor2]

babdallas, fiz alguns testes e deu tudo certo, muito obrigado!

Apenas mais uma dúvida.Caso eu queria deixar esse codigo universal para as outras abas(mantendo os shapes de acordo com a numeraçao).

Qual alteração eu devo fazer?

With wshPrincipal and ?
For Each rngCelulas In .ListObjects("tbTipo"&"tbtipo2").ListColumns("Tipo Cor").DataBodyRange
strNomeForma = CStr(rngCelulas.Offset(, -1).Value2)

[babdallas]

Nomearia cada tabela de acordo com o nome acrescido de um índice (na primeira planilha tbTipo1, na segunda tbTipo2 e assim por diante). As formas tb precisariam ser nomeadas diferentes de acordo com o índice da planilha, exemplo: primeira planilha 1_186, segunda planilha seria 2_186, etc. Algo Assim:

OBS: este código eu não testei. É apenas uma alternativa.

Código: Selecionar todos

Public Sub PreencherCorFormas()
    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 lngContPlan     As Long

    For each wshPlan in ThisWorkbook.Worksheets
         lngContPlan = lngContPlan + 1

        with wshPlan
               For Each rngCelulas In .ListObjects("tbTipo" & lngContPlan).ListColumns("Tipo Cor").DataBodyRange
                   strNomeForma = CStr(rngCelulas.Offset(, -1).Value2)
              
                   lngCor = .Range(rngCelulas.Value).Interior.Color
                   lngRed = lngCor Mod 256
                   lngGreen = (lngCor \ 256) Mod 256
                   lngBlue = (lngCor \ 65536) Mod 256
            
                   .Shapes.Range(lngContPlan & "_" & strNomeForma).Fill.ForeColor.RGB = RGB(lngRed, lngGreen, lngBlue)
            
             Next rngCelulas

        end with
    Next wshPLan
    
End Sub