Mapa Personalizável

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:

para criar esse gradiente podes ir até formatação condicional e selecionar esse tipo (use a quantidade de números que quiser, quanto mais, mais preciso será o gráfico! no exemplo anexo temos 300 números) :

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!

depois de feito o sumário, vamos aos códigos propriamente ditos:

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

Dessa forma o range fica variável sem ter que declarar cada imagem.

Bom trabalho!