Google Charts: Visualization - Map
w EXCELU :-)
  strona główna:
A po co ten Excel ;-)
 
 
   Dziś ciąg dalszy wykorzystywania narzędzie google do xl'celów ;-) a mianowicie zaznaczanie punktów na mapie.  
 
W Excel'u 2013 można zadanie  
realizować przez:  
Maps in Power View  
ale że ja się na razie nie   
przesiadam rozwiązania  
opieram na innych narzedziach  
 
Jak poprzednio w temacie:  
GeoChart Markers Example  
mapę wyświetlam na  
WebBrowser. Ciekawych jak  
wstawić tę kontrolkę do  
Arkusza zapraszam do  poprze-  
dniego tematu.  
 
Prezentowane dziś rozwiązanie  
oparte jest o wykorzystanie  
Google Charts Visualization: Map  
 
 
 
 
Żeby określić zakres zadania - klika faktów na początek:  
 - przykładowy kod który dostosowujemy do swoich potrzeb wyglada następująco:  
 
<html>   Google Charts
Visualization: Map
  <head>  
    <script type="text/javascript" src="https://www.google.com/jsapi"></script>  
    <script type="text/javascript">  
      google.load("visualization", "1", {packages:["map"]});  
      google.setOnLoadCallback(drawMap);  
      function drawMap() {  
        var data = google.visualization.arrayToDataTable([
 
          ['Lat', 'Lon', 'Name'],  
          [37.4232, -122.0853, 'Work'],  
          [37.4289, -122.1697, 'University'],  
          [37.6153, -122.3900, 'Airport'],  
          [37.4422, -122.1731, 'Shopping']  
        ]);  
 
        var map = new google.visualization.Map(document.getElementById('map_div'));  
        map.draw(data, {showTip: true});
 
      }  
    </script>  
  </head>  
 
  <body>  
    <div id="map_div" style="width: 400px; height: 300px"></div>  
  </body>  
</html>  
 
    Na dobrą sprawę można by nie podawać współrzędnych a po prostu adresy…  
 
Data Format  
Two alternative data formats are supported:  
1. Lat-Long pairs - The first two columns should be numbers designating the latitude and longitude, respectively. An optional third column holds a string that describes the location specified in the first two columns.  
 
2. String address - The first column should be a string that contains an address. This address should be as complete as you can make it. An optional second column holds a string that describes the location in the first column. String addresses load more slowly, especially when you have more than 10 addresses.  
 
 
Więc można iść na łatwiznę (!) i powinno działać :-P  ale…  
 
Note: The Lat-Long pairs option loads maps much faster, especially with large data. We recommend that you use this option for large data sets. Please visit Google Maps API to find out how to transform your addresses to lat-long points. The map can display a maximum of 400 entries; if your data holds more than 400 rows, only the first 400 will be shown.  
 
 
 
Mnie przekonuje szybkość działania. Poza tym wspomniane Google Maps API jakieś mega skomplikowane nie są więc "damy rade" :-)  
Pojawia się jednak kolejna istotna sprawa: ograniczenie - max 400 punktów na mapie. Jak dla mnie to i tak "masa" :-)  
 
 
Option Explicit  
 
Private Type GeoPoint  
    lat As String  
    lng As String  
End Type  
 
Private Sub CommandButton1_Click()  
    On Error GoTo CommandButton1_Error  
 
    Dim strPAth As String: strPAth = ThisWorkbook.Path & "\temp.html"  
      
    HTMLTempfile strPAth, TblToString([tblDane])  
 
    With Me.WebBrowser1  
        .Navigate strPAth  
         Do: DoEvents: Loop Until .ReadyState = READYSTATE_COMPLETE  
                  
        .Document.parentWindow.scrollto 10, 5  
        .Document.Body.Scroll = "no"  
    End With  
          
CommandButton1_Exit:  
    On Error Resume Next  
    VBA.Kill strPAth  
    Exit Sub  
              
CommandButton1_Error:  
    MsgBox Err.Number & ": " & Err.Description  
    Resume CommandButton1_Exit  
End Sub  
 
Sub HTMLTempfile(strHTMLFilePAth As String, tblDane As String)  
    Dim arrLines(1 To 28) As String, i As Long  
 
    arrLines(1) = "<html>"  
    arrLines(2) = "  <head>"  
    arrLines(3) = "    <script type=""text/javascript"" src=""https://www.google.com/jsapi""></script>"  
    arrLines(4) = "    <script type=""text/javascript"">"  
    arrLines(5) = "      google.load(""visualization"", ""1"", {packages:[""map""]});"  
    arrLines(6) = "      google.setOnLoadCallback(drawMap);"  
    arrLines(7) = "      function drawMap() {"  
    arrLines(8) = "        var data = google.visualization.arrayToDataTable(["  
    arrLines(9) = tblDane  
    arrLines(10) = "       ]);"  
    arrLines(11) = ""  
    arrLines(12) = "          var options = {"  
    arrLines(13) = "            showTip: true,"  
    arrLines(14) = "            showLine: false,"  
    arrLines(15) = "            lineColor: '#800000',"  
    arrLines(16) = "            lineWidth: 10,"  
    arrLines(17) = "            mapType: 'normal'," ' 'normal', 'terrain', 'satellite' ,'hybrid'.  
    arrLines(18) = "            useMapTypeControl: true"  
    arrLines(19) = "          };"  
    arrLines(20) = "        var map = new google.visualization.Map(document.getElementById('map_div'));"  
    arrLines(21) = "        map.draw(data, options);"  
    arrLines(22) = "      }"  
    arrLines(23) = "    </script>"  
    arrLines(24) = "  </head>"  
    arrLines(25) = "  <body>"  
    arrLines(26) = "    <div id=""map_div"" style=""width: 600px; height: 400px;""></div>"  
    arrLines(27) = "  </body>"  
    arrLines(28) = "</html>"  
 
    Dim intNR As Integer: intNR = VBA.FreeFile  
              
    Open strHTMLFilePAth For Output As #intNR  
        For i = 1 To UBound(arrLines)  
            Print #intNR, arrLines(i)  
        Next  
    Close #intNR  
          
End Sub  
 
Function TblToString(tblDane As Variant) As String  
    Dim tbl As Variant: tbl = tblDane  
    Dim i As Long  
    Dim strText As String: strText = "['Lat', 'Lon', 'Name'],"  
    Dim location As GeoPoint  
 
    For i = 1 To UBound(tbl)  
        location = GeoCoder(GoogleAddress(tbl(i, 1)))  
        With location  
            strText = strText & "[" & .lat & "," & .lng & ",'" & tbl(i, 1) & "'],"  
        End With  
    Next  
    TblToString = Left(strText, Len(strText) - 1)  
End Function  
 
Private Function GeoCoder(ByVal address As String) As GeoPoint  
    Dim msXML As Object  
    Dim strURL As String  
      
    strURL = "http://maps.googleapis.com/maps/api/geocode/json?" & _  
             "address=" & address & _  
             "&sensor=true"  
               
    Set msXML = CreateObject("Microsoft.XMLHTTP")  
    With msXML  
        .Open "GET", strURL, False  
        .send  
        GeoCoder.lat = Replace(Split(Fragment_RegExp(.responseText, "lat.+"), ":")(1), ",", "")  
        GeoCoder.lng = Split(Fragment_RegExp(.responseText, "lng.+"), ":")(1)  
    End With  
    Set msXML = Nothing  
End Function  
 
Function GoogleAddress(ByVal strAddress As String) As String  
    Dim iArr As Integer, arrPL, arrRepl  
    Dim strNewText As String: strNewText = strAddress  
              
    arrPL = VBA.Array(" ", "Ł", "ł", "ń", "ó", _  
                           "ź", "ę", "ą", "ż", _  
                           "Ż", "Ś", "ś")  
                                  
    arrRepl = VBA.Array("%20", "%C5%81", "%C5%82", "%C5%84", "%C3%B3", _  
                               "%C5%BA", "%C4%99", "%C4%85", "%C5%BC", _  
                               "%C5%BB", "%C5%9A", "%C5%9B")  
              
              
    For iArr = LBound(arrPL) To UBound(arrPL)  
        strNewText = Replace(strNewText, arrPL(iArr), arrRepl(iArr))  
    Next  
    GoogleAddress = strNewText  
End Function  
 
Function Fragment_RegExp(vText As Variant, strPattern As String) As String  
    On Error GoTo Fragment_RegExp_Error  
    Dim objRegExp As Object 'VBScript.RegExp  
              
    Set objRegExp = VBA.CreateObject("VBScript.RegExp")  
    With objRegExp  
        .Global = True  
        .Pattern = strPattern  
        .MultiLine = True  
        Fragment_RegExp = .Execute(vText)(0)  
    End With  
              
Fragment_RegExp_Error:  
    Set objRegExp = Nothing  
End Function  
 
Co tu tłumaczyć?? ;-) … nie no.. Jest w sumie co ;-)  
 - ścieżka pliku tymczasowego który będzie ładowany do WebBrowser  
 
    Dim strPAth As String: strPAth = ThisWorkbook.Path & "\temp.html"  
 
 - plik tworzymy procedurą HTMLTempfile przekazując tablicę z adresami [tblDane] - nazwany zakres komóek.  
 
    HTMLTempfile strPAth, TblToString([tblDane])  
 
 - przekazywaną tablicę trzeba przerobić zgodnie z wzorekm kodu:  
 
Private Type GeoPoint  
    lat As String  
    lng As String  
End Type  
 
Function TblToString(tblDane As Variant) As String  
    Dim tbl As Variant: tbl = tblDane  
    Dim i As Long  
    Dim strText As String: strText = "['Lat', 'Lon', 'Name'],"  
    Dim location As GeoPoint  
 
    For i = 1 To UBound(tbl)  
        location = GeoCoder(GoogleAddress(tbl(i, 1)))  
        With location  
            strText = strText & "[" & .lat & "," & .lng & ",'" & tbl(i, 1) & "'],"  
        End With  
    Next  
    TblToString = Left(strText, Len(strText) - 1)  
End Function  
 
 - "['Lat', 'Lon', 'Name']" to stały nagłówek tabeli z danymi.  
 - GoogleAddress(tbl(i, 1)) zamienia wybrane znaki - spacje, "specjały j.polskiego" ;-) podmieniam te..  
 
    arrPL = VBA.Array(" ", "Ł", "ł", "ń", "ó", _  
                           "ź", "ę", "ą", "ż", _  
                           "Ż", "Ś", "ś")  
                                  
    arrRepl = VBA.Array("%20", "%C5%81", "%C5%82", "%C5%84", "%C3%B3", _  
                               "%C5%BA", "%C4%99", "%C4%85", "%C5%BC", _  
                               "%C5%BB", "%C5%9A", "%C5%9B")  
 
żadnego źródła tych kodów nie znalazłem a zebrane okresliłem kiedyś na potrzeby Google Maps:   Excel i Google Maps
 
 - jak już poprawię adres to określam współrzędne punktu. Są dwie: lat i lng - zebrane jako typ GeoPoint  
f. GeoCoder zwraca te współrzędne  
 
Private Function GeoCoder(ByVal address As String) As GeoPoint  
    Dim msXML As Object  
    Dim strURL As String  
      
    strURL = "http://maps.googleapis.com/maps/api/geocode/json?" & _  
             "address=" & address & _  
             "&sensor=true"  
               
    Set msXML = CreateObject("Microsoft.XMLHTTP")  
    With msXML  
        .Open "GET", strURL, False  
        .send  
        GeoCoder.lat = Replace(Split(Fragment_RegExp(.responseText, "lat.+"), ":")(1), ",", "")  
        GeoCoder.lng = Split(Fragment_RegExp(.responseText, "lng.+"), ":")(1)  
    End With  
    Set msXML = Nothing  
End Function  
 
Zabawa polega na wyłaniu na przeglądarkę adresu URL i odczytaniu zwróconej informacji. Mówiłem że Google Maps API to nic  
strasznego :-)  
 
Wymienione informacje wystarczą nam do stworzenia tablicy współrzędnych którą przekażemy do tymczasowego pliku z kodem js.   
Tworzącym mapę.  
 
    Jeszcze tylko dostępne opcje:   Configuration Options
 
    arrLines(12) = "          var options = {"  
    arrLines(13) = "            showTip: true,"  
    arrLines(14) = "            showLine: false,"  
    arrLines(15) = "            lineColor: '#800000',"  
    arrLines(16) = "            lineWidth: 10,"  
    arrLines(17) = "            mapType: 'normal'," ' 'normal', 'terrain', 'satellite' ,'hybrid'.   przykład do pobrania:
    arrLines(18) = "            useMapTypeControl: true"   geochart_map.zip
    arrLines(19) = "          };"  
 
 i przykład do pobrania :-)