Excel i Google Maps   strona główna:
A po co ten Excel ;-)
 
    W ramach weekend'owej, luźnej zabawy chciałem odświerzyć temat którym zajmowałem się już jakiś czas temu a dotyczył właśnie  
współpracy Excela i Google Maps. Wtedy byłem z tego średnio zadowolony :-|, kolejne próby szlifowania pomysłu skończyły się raczej  
niepowodzieniem, ale sprawy nie porzuciłem…  
 
    Zadanie polega na pokazaniu w Arkuszu   
Excela trasy między dwoma punktami.   
Jeżeli punkty są stałe zadanie jest dość   
proste:  
 
1. Wchodzimy na stronę Google Mapy.  
2. Wpisujemy początek i cel trasy.  
3. Klikamy POKAŻ TRASĘ  
4. Klikamy link (obok drukarki)  
5. Kopiujemy treść kodu HTML, którego  
    przeznaczeniem jest możliwość  
    wykorzystania go na naszej stronie..  
    My też właśnie z tego skorzystamy :-)  
 
6. Kopiujemy ten kod do notatnika i   
    zapisujemy plik jako: Test.html  
 
 
 
 
 
 
 
 
7. Do arkusza wstawiamy kontrolkę WebBrowser  
    i np. pod przyciskiem:  
 
Private Sub CommandButton1_Click()  
    With Me.WebBrowser1  
        .Navigate ThisWorkbook.Path & "\test.html"  
         Do: DoEvents: Loop Until .ReadyState = READYSTATE_COMPLETE  
        .Document.parentWindow.scrollto 10, 15  
        .Document.Body.Scroll = "no"  
    End With  
End Sub  
 
Całość po tej zabawie może wyglądać np.: tak :-)  
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
  przykład tego etapu
  google-maps-w-exce
www.excelforum.p
 
 
 
 
Jednak tak jak pisałem jest to sposób na umieszczenie w Excelu Google Maps z trasą pomiędzy stałymi/niezmiennymi punktami.  
Czy da się zrobić coś co będzimy mogli lepiej kontrolować tj. Wpiszemy w komórki dwie dowolne miejscowości a na naszej mapie  
pokaże się trasa między nimi??  
To właśnie zadanie leżało u mnie na warsztacie od jakiegoś czasu i tym się właśnie zajmowałem w wolnych chwilach tego weekned'u.  
 
Co więc trzeba zrobić żeby zrealizować zadanie…  
 
Zobaczmy co mamy w naszym pliku Test.html  
 
<iframe   
   width="580"   
   height="430"   
   frameborder="0"   
   scrolling="no"   
   marginheight="0"   
   marginwidth="0"   
   src="http://mapy.google.pl/maps?  
          f=d&amp;  
          source=s_d&amp;  
          saddr=Bia%C5%82ka+tatrz%C5%84ska&amp;  
          daddr=Zakopane&amp;  
          hl=pl&amp;  
          mra=ls&amp;  
          sll=52.025459,19.204102&amp;  
          sspn=6.816651,16.875&amp;  
          ie=UTF8&amp;  
          ll=49.344125,20.03766&amp;  
          spn=0.08997,0.17616&amp;  
          output=embed">  
</iframe>  
 
Fragment, które uznałem za istotne wyróżniłem niebieskim kolorem. Do realizacji zadania (przynajmniej na etapie na którym teraz   
jestem) okazują się nieistotne: sll i sspn :-P resztę trzeba policzyć! :-) Tak, tak… zabawa będzie polegała na grzebaniu w pliku  
Test.html a następnie wyswietleniu go na WebBrowser.  
    Najtrudniejszym zadaniem w całej zabawie jest naspianie funkcji która poda lokalizację (długość i szerokość geograficzną) danej  
miejscowości z samej jej nazwy…   
Z tego co czytałem zadanie realizuje się poprzez Google API a więc sklejamy zapytanie w formie adresu URL, wysyłamy to na   
przeglądarkę i zapisujemy jako wynik to co nam przeglądarka zwróci…    Sign Up for the Google Maps API
Piszą że do realizacji zadania w treści tego "zapytania" trzeba podać Key z rejestracji w Google Maps API Family, później testy  
pokazały że zmiana treści tego kodu nie powoduje kłopotów z realizacją zadania więc czy rzeczywiście koniecznie się rejestrować?  
    Funkcja taka może wyglądać  tak:  
 
Function GeoCode(ie As SHDocVw.InternetExplorer, strNazwa As String) As String  
    Dim sLocation As String  
    'Const strGMAPI_Key As String = "ABQITTTTItqT5jpf2szQ" & _  
                                   "Lz6qP1eeCxR9DOGT1mG1" & _  
                                   "usNGDexmVuVHAmtCjBRy1" & _  
                                   "_LUBG-VwQyXosC3FB3pmpWe_A"  
 
    Const strGMAPI_Key As String = "T"  
 
    sLocation = "http://maps.google.com/maps/geo?q=%20_" & _  
                strNazwa & _  
                "&output=csv&key=%20" & _  
                strGMAPI_Key  
    With ie  
        .Navigate sLocation  
        Do: DoEvents: Loop Until .ReadyState = READYSTATE_COMPLETE  
        GeoCode = .Document.Body.outerText  
    End With  
End Function  
 
(strGMAPI_Key - trochu zmieniłem. Jest tu żeby pkazać jak wygląda w wersji oryginalnej.)  
 
    Całość teraz wygląda tak:  
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 - w kom.D4 i D5 podajemy miejscowości: poczatkową i cel.  
 - pod przyciskiem Twórz Trasę:  
 
Private Sub CommandButton1_Click()  
      
    Application.ScreenUpdating = False  
      
    With Me.WebBrowser1  
          
        CreateTestHTML Me.WebBrowser1, _  
                       ThisWorkbook.Path & "\Test.html", _  
                       .Height * dblProp, .Width * dblProp, _  
                       Me.[D4], Me.[D5]  
 
        .Navigate ThisWorkbook.Path & "\test.html"  
         Do: DoEvents: Loop Until .ReadyState = READYSTATE_COMPLETE  
          
        .Document.parentWindow.scrollto 10, 15  
        .Document.Body.Scroll = "no"  
 
    End With  
      
    Application.ScreenUpdating = True  
End Sub  
 
Procedura CreateTestHTML tworzy plik Test.html. (Zapisana w mod. Standardowym)  
 
Option Explicit  
 
Public Const dblProp As Double = 1.3  
 
Sub CreateTestHTML(ieApp As SHDocVw.InternetExplorer, _  
                   strPath As String, _  
                   intHeight As Integer, intWidth As Integer, _  
                   strZMiasta As String, strDoMiasta As String)  
    Dim strText As String  
    Dim iArr As Integer  
      
    Dim arrPL As Variant, arrRepl As Variant  
      
      
    arrPL = VBA.Array(" ", "Ł", "ł", "ń", "ó", _  
                           "ź", "ę", "ą", "ż", _  
                           "Ż", "Ś", "ś")  
                             
    arrRepl = VBA.Array("+", "%C5%81", "%C5%82", "%C5%84", "%C3%B3", _  
                             "%C5%BA", "%C4%99", "%C4%85", "%C5%BC", _  
                             "%C5%BB", "%C5%9A", "%C5%9B")  
      
    Const strSep As String = "&amp;"  
      
    For iArr = LBound(arrPL) To UBound(arrPL)  
        strZMiasta = Replace(strZMiasta, arrPL(iArr), arrRepl(iArr))  
        strDoMiasta = Replace(strDoMiasta, arrPL(iArr), arrRepl(iArr))  
    Next  
      
    Dim strLication1 As String, strLication2 As String  
    Dim arrLoc1 As Variant, arrLoc2 As Variant  
    strLication1 = GeoCode(ieApp, strZMiasta): arrLoc1 = Split(strLication1, ","): [D7] = strLication1  
    strLication2 = GeoCode(ieApp, strDoMiasta): arrLoc2 = Split(strLication2, ","): [D8] = strLication2  
      
      
    Dim str_ll As String, str_sll As String  
    Dim str_sspn As String, str_spn As String  
      
    str_ll = [F10] & "," & [G10] '"49.344125,20.03766"  
      
    'str_ll = Replace(Round((Replace(arrLoc1(2), ".", ",") * 1 + _  
                            Replace(arrLoc2(2), ".", ",") * 1) / 2, _  
                         7), ",", ".") & "," & _  
             Replace(Round((Replace(arrLoc1(3), ".", ",") * 1 + _  
                            Replace(arrLoc2(3), ".", ",") * 1) / 2, _  
                         7), ",", ".")  
      
    str_sll = "0,0"  '"52.025459,19.204102"  
    str_sspn = "0,0"     '"6.816651,16.875"  
    str_spn = [F12] & "," & [G12]    '"0.08997,0.17616"  
      
    strText = "<iframe width=""" & intWidth & """" & "height=""" & intHeight & """" & _  
                    "frameborder=""0"" scrolling=""no"" marginheight=""0"" marginwidth=""0""" & _  
                    "src=""http://mapy.google.pl/maps?" & _  
                    "f=d" & strSep & _  
                    "source=s_d" & strSep & _  
                    "saddr=" & strZMiasta & strSep & _  
                    "daddr=" & strDoMiasta & strSep & _  
                    "hl=pl" & strSep & _  
                    "mra=ls" & strSep & _  
                    "sll=" & str_sll & strSep & _  
                    "sspn=" & str_sspn & strSep & _  
                    "ie=UTF8" & strSep & _  
                    "ll=" & str_ll & strSep & _  
                    "spn=" & str_spn & strSep & _  
                    "output=embed"">" & _  
             "</iframe>"  
    Dim intNR As Integer: intNR = VBA.FreeFile  
      
    Open strPath For Output As #intNR  
        Print #intNR, strText  
    Close #intNR  
      
End Sub  
 
 
dblProp to współczynnik proporcji pomiędzy wielkością okna WebBrowser a taką wielkoscią okna Google Maps które dość dobrze  
            wypełni miejsce na przeglądarce.  
 
    arrPL = VBA.Array(" ", "Ł", "ł", "ń", "ó", _  
                           "ź", "ę", "ą", "ż", _  
                           "Ż", "Ś", "ś")  
                             
    arrRepl = VBA.Array("+", "%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)  
        strZMiasta = Replace(strZMiasta, arrPL(iArr), arrRepl(iArr))  
        strDoMiasta = Replace(strDoMiasta, arrPL(iArr), arrRepl(iArr))  
    Next  
 
Polskie znaki trzeba zastąpić na ciągi których pochodzienia nie udało mi się ustalić. Wypisałem więc znaki które trzeba podmieniać i   
ciągni na które trzeba zamieniać i pętlą zmieniam nazwy podane w kom.D4 i D5 na akceptowalne przez google Maps. Space na + to  
przez fakt że wieloczonowe nazwy trzeba łączyć przez + a nie przez space. Zamiast o tym pamiętać…. :-)  
 
    strLication1 = GeoCode(ieApp, strZMiasta): arrLoc1 = Split(strLication1, ","): [D7] = strLication1  
    strLication2 = GeoCode(ieApp, strDoMiasta): arrLoc2 = Split(strLication2, ","): [D8] = strLication2  
 
Do strLocation# zwracam pozycję danej miejscowości. Wygląda ona np.: tak: 200,4,49.3891057,20.1050242  
Dzielę ten ciąg po przecinku zapisując wyniki do tablicy arrLoc#. Cały ciąg zapisuję jeszcze do komórki arkusza (D7 i D8) nie jest  
to konieczne, bo całość dalszych obliczneń można prowadzić w VBA jednak łatwiej mi wytłumaczyć te obliczenia w arkuszu.  
 
Ktoś by spytał: co tu liczyć? Okazuje się że mając dane dotyczące lokalizacji obu miejscowości celu nie osiągniemy. Okazuje się że  
potrzebujemy współżędnych punktu po środku pomiędzy miejscowościami.   
Do komórek F7, G7, F8 i G8 formułami wyciągam lokalizację obu miejscowości. Żeby określić "środek" sumę poszczególnych współżę-  
dnych dzielę przez 2. Wyniki są w komórakch: F10, G10. Wyniki złączone przecinkiem zapisujemy do zmiennej str_ll  
 
    str_ll = [F10] & "," & [G10] '"49.344125,20.03766"  
 
można było to policzyć w VBA…  
 
    'str_ll = Replace(Round((Replace(arrLoc1(2), ".", ",") * 1 + _  
                            Replace(arrLoc2(2), ".", ",") * 1) / 2, _  
                         7), ",", ".") & "," & _  
             Replace(Round((Replace(arrLoc1(3), ".", ",") * 1 + _  
                            Replace(arrLoc2(3), ".", ",") * 1) / 2, _  
                         7), ",", ".")  
 
Potrzebujemy jeszcze str_spn będąca "wysokością" na jakiej trzeba "ustawić kamerę" żeby oba punkty były widoczne na mapie.  
Dobrym (zdawałoby się) wynikiej jest wartość bezwzględna z różnicy pomiędzy danymi współżędnymi. Działa to całkiem nieźle choć  
nie zawsze dlatego wynik mnożę przez procent (kom.E12) jaki zapewnia optymalność realizacji zadania. W większości przypadków   
jest to wartość stała. Jednak wyprowadzenie tego parametru do komórki daje nam możliwość kontroli "przybliżenia" na mapie z komórki  
arkusza. Im większy procent tym wyżej "ustawiona kamera"  
 
Uzystane wyniki wprowadzam do ciągu który utwoży zawartosć pliku Test.html  
 
    strText = "<iframe width=""" & intWidth & """" & "height=""" & intHeight & """" & _  
                    "frameborder=""0"" scrolling=""no"" marginheight=""0"" marginwidth=""0""" & _  
                    "src=""http://mapy.google.pl/maps?" & _  
                    "f=d" & strSep & _  
                    "source=s_d" & strSep & _  
                    "saddr=" & strZMiasta & strSep & _  
                    "daddr=" & strDoMiasta & strSep & _  
                    "hl=pl" & strSep & _  
                    "mra=ls" & strSep & _  
                    "sll=" & str_sll & strSep & _  
                    "sspn=" & str_sspn & strSep & _  
                    "ie=UTF8" & strSep & _  
                    "ll=" & str_ll & strSep & _  
                    "spn=" & str_spn & strSep & _  
                    "output=embed"">" & _  
             "</iframe>"  
    Dim intNR As Integer: intNR = VBA.FreeFile  
      
    Open strPath For Output As #intNR  
        Print #intNR, strText  
    Close #intNR  
 
Teraz tylko…  
 
        .Navigate ThisWorkbook.Path & "\test.html"  
 
i zadanie zrealizowane :-D  
 
    Jedno słowo jeszcze na temat celu wyłączenia odświeżania ekranu na czas działania procedury..  
Na jednej przeglądarce wyświetlam mapę i wysyłam zapytania funkcją GeoCode. To co zwraca zapytanie zostaje wyświetlone na  
przeglądarce pomiędzy mapami. Lepiej było wyłączyć odświeżanie ekranu niż tworzyć dodatkową instancję przeglądarki co zaminę  
którejkolwiek miejscowości.  
   
    Ps: miejscowości muszą być podane jednoznacznie!! Inaczej mapa wskaże pierwsze dopasowanie. Nie koniecznie to czego    Przykład można pobrać:
oczekiwaliśmy. Trzeba wtedy dookreślić daną miejscowość powiatem, wojewódźtwem… np.: Harklowa, nowotarski - jasne! :-)   xlmaps.zip
 
Nie jest to jeszcze szczyt marzeń i choć wersja mnie zadowala nie wykluczone że jeszcze trochu czasu nad tym spedzę.. :-)