Pagina Inicial‎ > ‎Excel‎ > ‎

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!
Ĉ
MAP GRAPH.xlsm
(233k)
Josemar Machado,
23 de mar de 2015 11:03
v.1
Comments