MacroFacili: Carta geografica per provincia

In acluni report, quelli di vendita in modo particolare, è utile rappresentare i dati su di una carta geografica, creando quella che sia chiama mappa coropletica. In questo tipo di mappe non vengono indicati punti o posizioni ma le regioni (province, comuni) vengono colorate in base in base ai valori associati.

Spesso per fare questo vengono utlizzati programmi esterni collegati in vari modo ai dati, non sono sempre semplici da utilizzare e non sempre è possibile poi distribuire i file creati.

Esiste però anche un modo di inserire nei fogli Excel delle mappe create importando le carte geografiche nel formato EMF e colorandole poi attraverso alcune semplici macro. In questo modo la mappa farà parte a tutti gli effetti del nostro file Excel senza problemi di compatibilitò o licenze.

Un altro sicuro vantaggio è che sarò molto più facile personalizzarla secondo le nostre necessità e collegarla ai dati: ad esempio colorando le aree con gli stessi colori delle formattazione condizionale che abbiamo impostato per la tabella con i dati.

Nel nostro esempio la tabella dati è impostata come le colonne come da esempio a destra e comprende le 110 provincie italiane.

In particolare i dati utilizzati dalla macro sono:

la sigla della provincia, per associare la forma della provincia che è denomiata "Prov_XX";
il colore della cella della regione, usato come sfondo base;
il colore della cella dato, anche con formattazione condizionale.

Il funzionamento della macro è molto semplice, in breve:

scorre tutte le forme del foglio "Mappa" impostando lo sfondo a bianco e il bordo a grigio chiaro;
scorre le righe della tabella "TabDati";
per le province il cui "dato" è maggiore di 0 imposta lo sfondo uguale a quello della cella, colora il bordo di grigio scuro e porta la forma in primo piano;
alle altre province imposta lo sfondo uguale alla cella "regione".

Sub Colora_Province()
  Set Fa = Sheets("Mappa")
  Set Fi = Sheets("Dati")
  Set TabDati = Fi.Range("TabDati")
  Ri = 2

  For Each Shp In Fa.Shapes()
    Shp.Fill.ForeColor.RGB = RGB(255, 255, 255)
    Shp.Line.ForeColor.RGB = RGB(175, 175, 175)
  Next Shp

  While (Fi.Cells(Ri, 1) <> "")
    Sigla = TabDati.Cells(Ri, 6)
    Dato = TabDati.Cells(Ri, 7)

    Set Shp = Get_Shape(Fa, "Prov_" & Sigla)

    If (Dato > 0 And Not (Shp Is Nothing)) Then
      Shp.Fill.ForeColor.RGB = TabDati.Cells(Ri, 7).DisplayFormat.Interior.Color
      Shp.Line.ForeColor.RGB = RGB(50, 50, 50)
      Shp.ZOrder msoBringToFront
    Else
      Shp.Fill.ForeColor.RGB = Fi.Cells(Ri, 3).Interior.Color
    End If
    Ri = Ri + 1
  Wend
End Sub

Questa parte della macro, mantenuta separata per chiarezza, è necesaria perchè nel caso di raggruppamenti di forme la funzione Shapes(Nome forma) non funziona correttamente.

Function Get_Shape(F, Name) As Object
  Set Get_Shape = Nothing

  On Error Resume Next
  Set Get_Shape = F.Shapes(Name)

  If Err.Number <> 0 Then
    For Each Shp In F.Shapes()
      For Each Shp1 In Shp.GroupItems
        If (Shp1.Name = Name) Then
          Set Get_Shape = Shp1
        End If
      Next Shp1
    Next Shp

  End If
End Function

L'esempio completo é scaricabile da questo link: Es122.xlsm (a questo link le info per attivare le macro se risultano bloccate)

Gli esempi contenuti nel sito sono per uso personale, non é consentito l'uso professionale, commerciale o la riproduzione senza autorizzazione.

Per dubbi o domande potete scriverci a domande@macrofacili.it, sulla nostra pagina FB MacroFacili.it o sul gruppo FB Excel, macro e formule.