1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87
| '-------------------------------------------------------------------------------
' Pensez à ajouter les bibliothéques "Microsoft HTML Object Library"
' et "Microsoft Internet Controls".
'-------------------------------------------------------------------------------
'-------------------------------------------------------------------------------
Public Function DuréeTrajetEntreAdresses(AdresseDépart As String, AdresseArrivée As String, _
Optional VoirGoogleMaps As Boolean = False) As Long
'-------------------------------------------------------------------------------
' Renvoie la durée du trajet entre deux adresses passées en argument, en
' utilisant Google Maps, exprimée en minutes ou 0 si erreur.
'-------------------------------------------------------------------------------
Dim i As Byte
If AdresseDépart = AdresseArrivée Then Exit Function
If AdresseDépart = "" Or AdresseArrivée = "" Then Exit Function
' Lance GoogleMars. Si erreur alors 0 et recommence (maxi 10 fois):
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Do
DuréeTrajetEntreAdresses = TrajetGoogleMaps(AdresseDépart, AdresseArrivée, VoirGoogleMaps)
i = i + 1: If i > 10 Then Exit Do
Loop While DuréeTrajetEntreAdresses = 0
End Function
'-------------------------------------------------------------------------------
Public Function TrajetGoogleMaps(AdresseDépart As String, AdresseArrivée As String, _
Optional VoirGoogleMaps As Boolean = False) As Long
'-------------------------------------------------------------------------------
' Ouvre Google Maps sur le calcul du trajet des adresses passées en arguments.
' Retourne : la durée du trajet en minutes (sans circulation), ou 0 si ereur.
' Exemple d'appel : TrajetGoogleMaps("22 rue Cassette, 75006, Paris", "Bordeaux")
'-------------------------------------------------------------------------------
Dim IE As New InternetExplorer
Dim IEDoc As HTMLDocument
Dim i As Long, Min As Integer, h As Integer, T As Double
Dim OldStatusBar As Boolean ' Mémorise l'état d'origine de la barre d'état.
Dim OldCursor As Long ' Mémorise l'état d'origine du curseur.
On Error Resume Next
' Active la barre d'état:
OldStatusBar = Application.DisplayStatusBar
Application.DisplayStatusBar = True
Application.StatusBar = "Calcul du trajet : " & AdresseDépart & " / " & AdresseArrivée
OldCursor = Application.Cursor
Application.Cursor = xlWait
' Ouvre IE, et lance le calcul:
IE.Visible = VoirGoogleMaps
IE.navigate "https://www.google.fr/maps/dir/" & AdresseDépart & "/" & AdresseArrivée
' Attend que IE soit disponible:
Do Until IE.readyState = READYSTATE_COMPLETE And IE.Busy = False
DoEvents
Loop
' Recherche dans le document où est écrit le résultat "sans circulation":
Set IEDoc = IE.document
T = Timer: While T + 1 > Timer: Wend
' Pointe sur le champ qui contient le trajet calculé:
Set Ret = IEDoc.getElementsByClassName("section-directions-trip-summary section-directions-trip-secondary-text")
' Extraction dans le libellé de la durée en minutes et heures:
Min = InStr(1, Ret.Item(0).textContent, "min", vbTextCompare)
If Min > 0 Then Min = Mid(Ret.Item(0).textContent, Min - 3, 2)
h = InStr(1, Ret.Item(0).textContent, "h", vbTextCompare)
If h > 0 Then h = Mid(Ret.Item(0).textContent, h - 3, 2)
' Convertion en minutes de la durée:
TrajetGoogleMaps = h * 60 + Min
' Si VoirGoogleMaps est vrai:
If VoirGoogleMaps = True Then MsgBox "Cliquez ici pour fermer Google Maps", vbOKOnly, "Google Maps"
' Ferme Internet:
IE.Quit
Set IE = Nothing
' Restaure la barre d'état d'origine:
Application.StatusBar = ""
Application.Cursor = OldCursor
Application.DisplayStatusBar = OldStatusBar
End Function
'------------------------------------------------------------------------------- |
Partager