Skuteczna prezentacja danych, dotycząca obszarów geograficznych może zostać przeprowadzona za pomocą kartogramu. Kartogram to wykres w postaci mapy, na którym wielkość danego zjawiska prezentowana jest za pomocą zmiany natężenia koloru, w ramach wyznaczonych granic przedziałów klasowych. Zbudowanie kartogramu w Excelu może wydać się skomplikowane, tym bardziej jeżeli nie dysponujemy dodatkiem PowerView. Niemniej jednak, przy odrobinie VBA i informacji o tym jak zdobyć interesujące nas kształty mapy, możemy te trudności przezwyciężyć. Zapraszam do lektury postu, który bazuje na pomyśle zaczerpniętym ze strony Roberta Mundigla http://www.clearlyandsimply.com/. Gotowy plik z mapą można pobrać tutaj.
1. Pozyskanie mapy
Pierwszym krokiem milowym, do stworzenia kartogramu w Excelu jest pozyskanie kształtów interesujących nas obszarów geograficznych. W tym celu skorzystamy z formatu grafiki wektorowej SVG i strony http://www.amcharts.com/svg-maps/, z której pobierzemy interesującą nas mapę Polski, w podziale na województwa (ściągamy wersję Low detail).
Kiedy mamy już ściągniętą mapę w postaci SVG musimy przerobić jej format na EMF (Enhanced Meta File) za pomocą programu Inkscape do pobrania tutaj. Otwieramy naszą mapkę w nowo pobranym programie i skalujemy jej wielkość tak, aby zmieściła się w wyznaczonym białym prostokącie.
Nowo powstałą mapę zapisujemy jako plik w formacie Enhanced Meta File (*.emf). Podczas zamykania pliku pojawi się ostrzeżenie - klikamy Nie zapisuj.
Teraz otwieramy nowy skoroszyt Excela z obsługą makr i zmieniamy nazwy arkuszy na Mapa, Dane oraz Obliczenia. W arkuszu Mapa na karcie Wstawianie, klikamy ikonkę Obrazy i wstawiamy nasz plik emf o nazwie Mapa. Pojawi się nam mała mapka Polski, którą rozszerzamy do interesujących nas rozmiarów. Następnie klikamy na mapkę prawym klawiszem myszki, podświetlamy ikonkę Grupuj i wybieramy Rozgrupuj. Przy pojawieniu się ostrzeżenia dotyczącym konwersji na obiekt rysunkowy Microsoft Office wybieramy Tak. Po potwierdzeniu wykonujemy ponownie tą samą operację czyli PPM-->Grupuj-->Rozgrupuj. Tym razem nasze działanie przyniosło skutek w postaci rozdzielenia poszczególnych województw na osobne obiekty o nazwie Freeform + numer. Po operacji rozgrupowania klikamy obok dowolnego województwa i usuwamy zaznaczony kształt ramki o nazwie AutoShape2.
2. Nazwanie kształtów
Otwierając plik EMF w Excelu straciliśmy informację o nazwach województw przypisanych do każdego kształtu. Excel automatycznie przypisał im nazwy Freeform1, 2 itd. Chcąc w szybki sposób odzyskać pierwotne nazwy posłużymy się naszym plikiem SVG oraz dwoma makrami. Na początku otwórzmy plik SVG w Excelu - upuszczając jego ikonę na dowolnym arkuszu. Pojawi się nam komunikat ostrzegający przed otwarciem pliku w innym formacie - klikamy Tak. Następnie wybieramy opcję otwarcia pliku jako tabela XML.
Z tabeli wycinamy dwie kolumny (id oraz title) i wklejamy je do arkusza Mapa, tak aby nagłówek kolumny id znajdował się w kolumnie N1. Przyszedł czas na makra, dzięki którym przywrócimy pierwotne nazwy województw. Otwierając plik EMF w Excelu straciliśmy informację o nazwach województw, ale kolejność w jakiej zostały ponumerowane poszczególne kształty, równa się kolejności z pliku SVG. Wykorzystując ten fakt, utwórzmy w arkuszu Mapa poniższe makra. Makro GetShapeNames, wymieni w zakresie komórek M2:M17 nazwy wszystkich kształtów w arkuszu, natomiast makro SetShapeNames zmieni wymienione nazwy, na nazwy z kolumny N.
Option Explicit
Sub GetShapeNames()
Dim shp As Shape
Dim i As Long
i = 1
For Each shp In ActiveSheet.Shapes
ActiveSheet.Range("M1").Offset(i, 0).Value = _
ActiveSheet.Shapes(i).Name
i = i + 1
Next shp
End Sub
Sub SetShapeNames()
Dim shp As Shape
Dim i As Long
i = 1
For Each shp In ActiveSheet.Shapes
ActiveSheet.Shapes(i).Name = _
ActiveSheet.Range("N1").Offset(i, 0).Value
i = i + 1
Next shp
End Sub
3. Przygotowanie kartogramu
Kiedy kształty mapy zostały już nazwane, przystępujemy do przygotowania danych dla naszego kartogramu. Do arkusza Dane przenosimy naszą tabelkę z ID i Nazwą województwa oraz dodajemy do niej nasze dane.
Aby kartogram mógł zmieniać swoje barwy, musimy dodać do niego możliwość wyboru danych. Z karty Deweloper wstawiamy Pole kombi formularza i umieszczamy je w arkuszu Mapa. Kopiujemy nagłówki naszych danych (wynagrodzenie i ludność) i wklejamy je do arkusza Obliczenia do komórek M5 i M6 - będzie to zakres wejściowy Pola kombi. Jako łącze komórki wybieramy komórkę M4.
Przejdźmy teraz do arkusza Dane gdzie dodamy nową kolumnę o nazwie Wybrana opcja. W komórce E3 umieszczamy funkcję =INDEKS(C3:D3;Obliczenia!$M$4), która jest połączona z Polem Kombi i na jego podstawie wybierze właściwe dane z tabeli. Następnie na podstawie nr ID i wartości z kolumny Wybrana opcja utworzymy nazwy zdefiniowane. Kopiujemy nr ID do komórki F3, klikamy na kartę Formuły i z grupy Nazwy zdefiniowane wybieramy Utwórz z zaznaczenia. W pojawiającym się okienku wybieram "z prawej kolumny". W ten sposób szybko utworzyliśmy nazwy odnoszące się do wartości z kolumny Wybrana opcja. Kolumnę z pomocniczym ID możemy usunąć.
Przenieśmy się teraz do arkusza Obliczania, w którym ustalimy odcienie jakie będą przyjmować nasze województwa. Należy wykonać następujące kroki:
- w komórce B1 wpisujemy 5 (będzie to stopień odcienia barwy - im mniejszy tym ciemniejsze będą poszczególne kolory)
- w zakresie A4:D4 umieszczamy nagłówki kolumn nowej tabeli (Kroki, Granica, RGB oraz Max/Min)
- do komórki A54 wpisujemy wartość zero, natomiast to A53 wpisujemy formułę =A54+$B$1 i przeciągamy w górę aż do nagłówka Kroki
- w komórkach D5 i D6 przy pomocy funkcji MAX i MIN znajdujemy krańcowe wartości z kolumny Wybrana opcja arkusza Dane
- do komórki D7 wprowadzamy formułę =(D5-D6)/48, która wyznaczy współczynnik, określający przedziały kolorystyczne kartogramu
Po wprowadzeniu wszystkich zmian dodajemy nowy moduł do naszego arkusza, w którym umieszczamy funkcję użytkownika określającą kolor. Dodajemy również dwa makra odpowiedzialne za wybranie stosownego koloru i zabarwienie nim kształtu województwa.
Option Explicit
Function udf_RGB(myR As Byte, myG As Byte, myB As Byte) As Long
udf_RGB = RGB(myR, myG, myB)
End Function
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
Funkcję użytkownika udf_RGB wpisujemy do komórki C5 i przeciągamy do C54, definiując parametry funkcji jako wartości z kolumny Kroki. Następnie do komórki I4 kopiujemy kolumnę ID z arkusza Dane a obok wstawiamy kolumnę Nazwa zdefiniowana. W kolumnie Nazwa zdefiniowana wpisujemy nr ID województw pamiętając aby zamienić znak "-" na "_". Zmiana ta jest istotna, gdyż później dane z tej kolumny posłużą nam do zdefiniowania nowej nazwy zdefiniowanej. Całość powinna wyglądać jak poniżej.
Przyszedł czas na zdefiniowanie wspomnianych przed chwilą nazw. Pierwsza z nich to zakres =Obliczenia!$B$5:$C$54 o nazwie MapValueToColor oraz =Obliczenia!$H$5:$I$20 jako MapNameToShape. Na koniec do naszego Pola kombi przypisujemy utworzone wcześniej makro UpdateMap. Kartogram gotowy !
Jeżeli jesteś zainteresowany podjęciem współpracy przy tworzeniu bardziej zaawansowanej mapy, na której będziesz miał możliwość dodania:
- wykresów kołowych, słupkowych lub bąbelkowych dla danego obszaru
- legendy na, której precyzyjnie określisz zakres klas danego zjawiska
- komunikatu o nazwie obszaru i przypisanej do niego wartości
Napisz pod kontakt@excelraport.pl
6 thoughts on “Mapa Polski w Excelu (kartogram)”
Bardzo pomocny artykuł. Mam jednak pytanie, ponieważ nie ujął Pan w artykule skąd wzięły się i co oznaczają wartości w kolumnie “Granica”. Druga sprawa, po wpisaniu funkcji udf_RGB() zależnej od parametru “Kroki” wyskakuje mi komunikat #ARG!.
Witaj,
jeżeli chodzi o błąd to być może wynika on z tego, że jako wartość “Odcienia” wybrałeś liczbę większą niż 5, dla której maksymalna wartość “Kroki” nie może być większa niż 255, gdyż użyte w funkcji udf_RGB zmienne, określone są jako Byte (zmienna obsługuje liczby naturalne z przedziału 0-255, jest to też przedział w jakim zapisuje się wszystkie kolory RGB).
Co do oznaczenia “Granica”. Wybierając z pola kombi opcje Ludność lub Średnie miesięczne wynagrodzenie, deklarujesz opcję, dla której będą określone odcienie koloru RGB poszczególnych województw. I tak np. dla “Odcienia” = 5 i opcji Ludność na 1 km2, województwo Pomorskie przyjmuje wartość równą 126. Wartość ta mieści się w przedziale “Granica” w widełkach od 124,21 do 130,73. W tym wypadku makro wybiera dolny zakres przedziału i przypisuje my wartość numeryczną indeksu RGB = 12 829 635, lub inaczej RGB (195,195,195) – stąd kolor poszczególnego województwa.
Pozdrawiam,
Paweł
p.Robertowi chodziło zapewne skąd się biorą wartości w kolumnie “granica”, bo nie zostało to podane.
pierwsze pole B5 jest równe Minimalnej wartości z kol. D (D6), każde następne przez dodanie współczynnika $D$7
Bardzo pomocny artykuł. Mam jedno pytanie odnośnie wyglądu mapki. Istotne dla oglądającego kartogram jest skala porównawcza, czyli rząd wielkości przypisany do danego odcienia. Czy możliwe jest utworzenie histogramu i jak go utworzyć obok mapy?
Witaj,
w oryginalnym pomyśle zaczerpniętym ze strony http://www.clearlyandsimply.com autor posłużył się zwykłą skalą kolorów określającą jedynie przedziały wartości od najmniejszych do największych.
Aby osiągnąć ten efekt należy:
1. skopiować dane z kolumny “kroki” i wkleić je w osobnym arkuszu w komórkach A1-C1 np. 245 245 245
2. wstawić do modułu arkusza następującą UDF
Function myRGB(r, g, b)
Dim clr As Long, src As Range, sht As String, f, v
If IsEmpty(r) Or IsEmpty(g) Or IsEmpty(b) Then
clr = vbWhite
Else
clr = RGB(r, g, b)
End If
Set src = Application.ThisCell
sht = src.Parent.Name
f = “Changeit(“”” & sht & “””,””” & _
src.Address(False, False) & “””,” & clr & “)”
src.Parent.Evaluate f
myRGB = “”
End Function
Sub ChangeIt(sht, c, clr As Long)
ThisWorkbook.Sheets(sht).Range(c).Interior.Color = clr
End Sub
3. w komórce D1 użyć wspomnianej funkcji z parametrami z komórek A1-C1 i przeciągnąć w dół
4. pokolorowane komórki skopiować i wkleić jako obraz
Jeżeli to rozwiązanie nie okaże się dla Ciebie wystarczające odsyłam do 2óch kolejnych postów Roberta, w których poruszana jest kwestia legendy 1, 2.
Pozdrawiam