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
'------------------------------------------------------------------------------- |
VBA + Internet (Google Maps ?) : Calcul des kilomètres entre deux adresses
Répondre avec citation
Envoyé par umfred
Partager