Como criar um mapa personalizável? Simples para que conhece VBA: Primeiro precisamos entender como funcionam as cores RGB: MyColor = RGB(Cor1 Mod 256, (Cor1 Mod 256 ^ 2) \ 256, Cor1 \ 256 ^ 2) 'onde Cor1 é igual ao objeto com a cor que gostaria de capturar! com esta formula conseguimos capturar o valor do RGB que será usado. Depois precisamos de uma figura criada estado por estado. (esse tem que ser no braço mesmo...) Criado o mapa estado por estado, iremos nomear da seguinte forma: S_RS S_RJ S_SP S_MT ... Assim conseguiremos relacionar mais tarde com os nomes dos estados. depois Precisaremos da base de dados para montar o grafico: Como no exemplo do anexo. temos varias tabelas que foram criadas e podem ser alteradas. no exemplo temos a primeira tabela que indica vendas por estado mensal. Também podemos montar uma personalizável identificada por nomes: No exemplo temos frutas por estados, ai determinamos uma cor para cada fruta, ao rodar o código ele captura a cor que esta na célula e transforma em valor RGB. Para que consigamos levar os dados para o banco precisamos ou personalizar (como acima) ou criar um gradiente como abaixo: após fazer isso copie e cole no Word, depois copie e cole de volta no excel, pois o excel não interpreta a formatação condicional como sendo realmente a cor da célula, para isso basta copiar e colar para o Word e depois trazer de volta... Depois de criado o gráfico, nomeada cada imagem, feito as tabelas. temos que ter um índice para buscar os dados, temos isso em um outro tópico, procure! Sub CheckColor(myCell As Range, myNameToShape As String, myValueToColor As String) Dim myShape As Shape Dim myTargetCell As Range Dim myColorCode As Long On Error GoTo Catch Set myTargetCell = Range(myNameToShape).Columns(1).Find(myCell.Name.Name, LookAt:=xlWhole) Set myShape = Sheets(1).Shapes(myTargetCell.Offset(0, 1)) GoTo Finally Catch: Exit Sub Finally: On Error GoTo 0 If myCell.Value < Range(myValueToColor).Cells(2, 1).Value Then myColorCode = Range(myValueToColor).Cells(1, 2).Value Else myColorCode = Application.WorksheetFunction.VLookup(myCell.Value, Range(myValueToColor), 2, True) End If myShape.Fill.ForeColor.RGB = myColorCode End Sub '------------------------------------------------------------------------------------------------------------------------------------------------ Sub UpdateMap() Dim myCell As Range Application.ScreenUpdating = False For Each myCell In Range("MapNameToShape").Columns(1).Cells CheckColor Range(myCell.Value), "MapNameToShape", "MapValueToColor" Next myCell Application.ScreenUpdating = True End Sub Com essa macro Checkcolor fazemos uma procura para encontrar o valor mais próximo de cor encontrado:
myColorCode = Application.WorksheetFunction.VLookup(myCell.Value, Range(myValueToColor), 2, True) Depois é somente definir uma cor para cada imagem de acordo com a nomeação dada: Range("MapNameToShape") E os valores em: MapValueToColor Bom trabalho! |
Pagina Inicial > Excel >