AW: Entfernung über Google Maps berechnen
02.09.2021 17:52:35
volti
Hallo Detlef,
da gibt es jede Menge Beispiele im Netz zu finden.
Vielleicht hilft Dir auch schon das anliegende, unangepasste Makro (ohne Google-Maps) aus meiner Bastelkiste weiter.
Einfach Entfernung in B3 und C3 in Tabelle1 eingeben und laufen lassen. Aus den anderen Feldern kann dann Fahrstrecke, Luftlinie und die entsprechenden Zeiten entnehmen. Wenn's gefällt, kannst Du es ja nach Deinen Wünschen umbauen.
Code:
[Cc][+][-]
Option Explicit
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Type DIST_STRUCT
Start As String ' Mehrere durch "/" getrennt eingeben
Ziel As String
LDist As String
FDist As String
LTime As String
FTime As String
End Type
Private Sub EntfernungErmitteln()
Dim tDist As DIST_STRUCT
Dim WS As Worksheet
Set WS = Worksheets("Tabelle1")
With tDist
.Start = WS.Range("B3").Value
.Ziel = WS.Range("C3").Value
GetDistance tDist
WS.Range("E3").Value = .FDist
WS.Range("G3").Value = .LDist
WS.Range("F3").Value = .FTime
WS.Range("H3").Value = .LTime
End With
End Sub
Private Sub GetDistance(tDist As DIST_STRUCT)
' Get-Methode
Dim oDoc As Object, i As Integer
With CreateObject("InternetExplorer.Application")
'.Visible = True
.Navigate "http://www.luftlinie.org/" _
& tDist.Start & "/" & tDist.Ziel ' Zur Url surfen
While Not .readyState = 4: DoEvents: Wend ' Warten bis Seite geladen ist
On Error Resume Next
Set oDoc = .Document
With tDist
If Not .Start Like "#####*" Then .Start = ""
If Not .Ziel Like "#####*" Then .Ziel = ""
Do
Sleep 100: i = i + 1
.FDist = oDoc.getElementById("strck").outertext
If Not .FDist Like "*--*" Then Exit Do
If i > 50 Then Exit Do
Loop
.LDist = oDoc.getElementsByClassName("value km")(0).outertext & " km"
.LTime = oDoc.getElementsByClassName("directionsResultTime0")(0).outertext
.FTime = oDoc.getElementsByClassName("directionsResultTimeTotal")(0).outertext
.Start = Trim$(.Start & " " & oDoc.getElementsByClassName("regions")(0).outertext)
.Ziel = Trim$(.Ziel & " " & oDoc.getElementsByClassName("regions")(2).outertext)
End With
.Quit ' IE schließen
End With
End Sub
_________________________
viele Grüße aus Freigericht 😊
Karl-Heinz