VBA + Internet (Google Maps ?) : Calcul des kilomètres entre deux adresses

**laurent_ott** · 19/07/2023, 13h56

Bonjour,
Jadis j'ai glané sur Internet un code pour calculer le nombre de kilomètres entre deux adresses... mais il est obsolète :

Code VBA :

Sélectionner tout - Visualiser dans une fenêtre à part

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
'-------------------------------------------------------------------------------

J'ai besoin d'une nouvelle version, qui me renvoie le nombre de kilomètres entre deux adresses et si possible la durée du trajet (le tout en mode voiture).
Si vous avez des pistes, ou un code tout fait, je suis preneur.

Merci d'avance.

**78chris** · 19/07/2023, 21h14

Bonjour

Je n'ai pas regardé le code en détail mais cela fait 2 ans environ que l'accès aux infos et calculs de Google map est payant...

**jurassic pork** · 20/07/2023, 07h05

Hello,

En fait le script ne fonctionne plus car googlemaps n'accepte plus internet explorer comme navigateur et la page a changé par rapport au script.
Plusieurs solutions pour remplacer le script :
1 - utiliser googleapis qui permet d'avoir directement en format xml un trajet en spécifiant que quelques paramètres exemple :
avec ce code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Sub RecupTrajet()
    Dim url As String
    url = "https://maps.googleapis.com/maps/api/distancematrix/xml" & _
          "?origins=Paris&destinations=Bordeaux&sensor=false&key=xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"
    Dim request As New MSXML2.XMLHTTP60
    request.Open "GET", url, False
    request.send
    If (request.Status <> 200) Then
        Debug.Print "HTTP Status is not OK (200)"
        Debug.Print request.responseText
    Else
         Debug.Print request.responseText
    End If
 
End Sub

j'obtiens ceci comme résultat (attention le paramètre key n'est pas valide dans le code ci-dessus) :

Code xml :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
 <status>OK</status>
 <origin_address>Paris, France</origin_address>
 <destination_address>Bordeaux, France</destination_address>
 <row>
  <element>
   <status>OK</status>
   <duration>
    <value>20859</value>
    <text>5 heures 48 minutes</text>
   </duration>
   <distance>
    <value>584930</value>
    <text>585 km</text>
   </distance>
  </element>
 </row>
</DistanceMatrixResponse>

concernant de savoir si cela peut-être gratuit(si on ne dépasse pas un certain quota) car cela est assez complexe à comprendre.
moi pour l'instant j'ai une api key et je n'ai rien payé à Google (Facturation à 0 €)
Sinon pour remplacer Internet Explorer il y a SeleniumBasic (voir ici ) mais cela oblige à installer le logiciel et le WebDriver du navigateur que l'on utilise. De plus SeleniumBasic n'a pas été mis à jour depuis 8 ans.
Il y aussi un nouveau projet qui utilise des modules de classes. Il s'agit de Chromium-Automation-with-CDP-for-VBA de Licence MIT

Chromium Automation for VBA - CDP Framework
This is a method to directly automate Chromium-based web browsers, such as Chrome, Edge, and Firefox, using VBA for Office applications by following the Chrome DevTools Protocol framework. This git is an enhanced framework based on the original pioneering article by ChrisK23 on CodeProject. You can find the original article as well as his example here at https://www.codeproject.com/Tips/530...dge-using-VBA\
What It Can Do
This method enables direct automation with Chromium-based web browsers for VBA without the need for a third-party software like SeleniumBasic. The framework also includes many examples and useful functions added to the original repository while keeping the whole design as simple as possible to help you understand and get started quickly with deploying the CDP framework for your VBA solutions.

En fait dans les releases il y a un complément .xlam qu'il faut télécharger et lancer et dedans il y a les modules de classes et un module de démo que l'on copie dans le classeur où l'on veut les utiliser. Cela rajoute environ 200Ko au classeur.

Voici un exemple pour obtenir la durée et la longueur d'un trajet dans googlemaps.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Public Sub TrajetGoogleMaps(AdresseDépart As String, AdresseArrivée As String, _
                                 Optional CacherGoogleMaps As Boolean = False)
'-------------------------------------------------------------------------------
' Ouvre Google Maps sur le calcul du trajet des adresses passées en arguments.
' Exemple d'appel : TrajetGoogleMaps("22 rue Cassette, 75006, Paris", "Bordeaux")
'-------------------------------------------------------------------------------
Dim objBrowser As New CDPBrowser
Dim result
    On Error Resume Next
    'on lance MS EDGE
    objBrowser.start "edge", cleanActive:=True, reAttach:=True
    ' on peut cacher le navigateur
    If CacherGoogleMaps Then objBrowser.hide
    objBrowser.navigate ("https://www.google.fr/maps/dir/" & AdresseDépart & "/" & AdresseArrivée)
    objBrowser.wait till:="interactive"
    'Clic sur le bouton qui correspond à  un trajet en voiture
    objBrowser.getElementByXPath("//button/img[@data-tooltip='Voiture']").click
    'Clic sur la section du résultat en attendant son apparition
    objBrowser.getElementByID("section-directions-trip-0").onExist.click
    'Récupération du texte qui donne le temps et le kilométrage du trajet en attendant son apparition
    result = objBrowser.getElementByXPath("//div[@class='TGDfee']").onExist.innerText
    Debug.Print result
    objBrowser.quit
End Sub
Sub TestTrajet()
   TrajetGoogleMaps "22 rue Cassette, 75006, Paris", "Bordeaux", False
End Sub

voici ce que j'obtiens :

5 h 51 min (581 km)

Ami calmant, J.P

**umfred** · 20/07/2023, 13h12

l'API Google DistanceMAtrix est payante (autant aller à la source pour l'info => https://developers.google.com/maps/d...-billing?hl=fr )

**jurassic pork** · 20/07/2023, 13h40

Envoyé par umfred

l'API Google DistanceMAtrix est payante (autant aller à la source pour l'info => https://developers.google.com/maps/d...-billing?hl=fr )

Dans le lien que j'ai mis voilà ce qui est expliqué et qui me laisse perplexe :

Informations sur les tarifs de l’API Google Maps
Il faut savoir que chaque requête est payante, dès la première. Cependant, Google vous offre tous les mois les 200 premiers dollars.

La seconde chose à connaître, c’est la notion de « niveaux ». De 0 à 100 000 (100k) requêtes, nous sommes au « niveau 1 ». Au-delà, nous passons au « niveau 2 », où le montant par requête est plus bas. Aussi, la facturation se fait par lots de 1 000 (1k) requêtes.

Dans la partie suivante, où tous les services vous seront présentés, il y aura quatre tarifs indiqués :

Tarifs « simple », niveau 1 : $2 / 1k requêtes ; niveau 2 : $1.60 / 1k requêtes.
Tarif « bas », niveau 1 : $5 / 1k requêtes ; niveau 2 : $4 / 1k requêtes.
Tarif « avancé », niveau 1 : $10 / 1k requêtes ; niveau 2 : $8 / 1k requêtes.
Tarifs « CGP », dépend de l’infrastructure utilisée pour le service.

Il faut dire que mon API key est dans un mode essai et devrait bientôt expirée

Pendant la période d'essai, votre premier compte de facturation Cloud est en mode d'essai, et aucuns frais ne sont facturés sur votre mode de paiement. L'essai prend fin une fois les 300 USD dépensés ou, au plus tard, au terme de la période d'essai.

Au plus tard le dernier jour de l'essai, vous devez mettre à niveau votre premier compte de facturation Cloud vers un compte payant pour éviter que l'utilisation de Google Maps Platform soit interrompue (consultez Passer à un compte payant).

**laurent_ott** · 20/07/2023, 15h39

Bonjour,
Merci pour vos réponses.
Vous devinez bien que je ne suis pas spécialiste du sujet mais est-il possible avec un objet créé par CreateObject("Microsoft.XMLHTTP") d'utiliser le site "https://www.coordonnees-gps.fr/itineraire" au lieu de "GoogleMaps", qui fait la même chose, y renseigner l'adresse d'origine (dans address), l'adresse de destination (addressDest) puis de cliquer sur le bouton "Calcul itinéraire" (btn btn-success).
Reste alors à lire le résultat.
Facile à dire mais peut-être plus compliqué à faire...

**jurassic pork** · 20/07/2023, 15h49

Envoyé par laurent_ott

Vous devinez bien que je ne suis pas spécialiste du sujet mais est-il possible avec un objet créé par CreateObject("Microsoft.XMLHTTP") d'utiliser le site "https://www.coordonnees-gps.fr/itineraire" au lieu de "GoogleMaps", qui fait la même chose, y renseigner l'adresse d'origine (dans address), l'adresse de destination (addressDest) puis de cliquer sur le bouton "Calcul itinéraire" (btn btn-success).
Reste alors à lire le résultat.
Facile à dire mais peut-être plus compliqué à faire...

Le souci c'est la saisie des adresses et le clic sur le bouton : sans navigateur cela me semble impossible : xmlhttp ne fait que récupérer du html il ne peut pas faire d'action sur la page. Donc la meilleure solution c'est le pilotage de navigateur ou alors l'utilisation d'une API (comme DistanceMatrix) mais dans ce cas il est rare que cela ne soit pas payant. C'est cette API que ton site "https://www.coordonnees-gps.fr/itineraire" utilise :

Les résultats de cette page sont obtenus à partir de l'API Google Maps Platform, jugée préférable à Mappy itinéraire ou Michelin itinéraire.

**jurassic pork** · 21/07/2023, 15h06

Hello,
la plus performante des solutions est bien sûr l' API googleapis qui met moins de 200 ms à renvoyer un résultat. Les autres solutions mettent plusieurs secondes. Avec un crédit gratuit de 200$ par mois et en limitant son quota à 1000 requêtes par jour (ce qui est faisable) , cela reste gratuit car un crédit de 200$ correspond à 40000 requêtes.
Donc si vous n'avez pas trop de requêtes à faire par jour vous pouvez envisager d'utiliser l'API googleapis sans coût. A vérifier quand même que ce que j'affirme n'est pas faux

Ami calmant, J.P

**umfred** · 21/07/2023, 18h11

Envoyé par jurassic pork

Hello,
la plus performante des solutions est bien sûr l' API googleapis qui met moins de 200 ms à renvoyer un résultat. Les autres solutions mettent plusieurs secondes. Avec un crédit gratuit de 200$ par mois et en limitant son quota à 1000 requêtes par jour (ce qui est faisable) , cela reste gratuit car un crédit de 200$ correspond à 40000 requêtes.
Donc si vous n'avez pas trop de requêtes à faire par jour vous pouvez envisager d'utiliser l'API googleapis sans coût. A vérifier quand même que ce que j'affirme n'est pas faux

Ami calmant, J.P

ça semble correct (si d'autres api sont utilisées, il faut penser à leur(s) coût(s) bien sûr)

**jurassic pork** · 22/07/2023, 07h48

Hello,
voici le code d'une fonction qui retourne la distance et la durée du trajet entre les deux paramètres : l'adresse de départ et l'adresse d'arrivée. Ce code utilise l'API Distance Matrix du service Maps de Google.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Function RecupTrajet(origine As String, destination As String) As String
    Dim url As String, urlencode As String
    Dim oXml As Object, oRequest As Object
    Set oXml = CreateObject("MSXML2.DOMDocument.6.0")
    Set oRequest = CreateObject("MSXML2.XMLHTTP.6.0")
    Const ApiKey = "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"
    url = "origins=" & WorksheetFunction.EncodeURL(origine) & "&destinations=" & _
           WorksheetFunction.EncodeURL(destination) & _
           "&sensor=false&key=" & ApiKey
    urlencode = "https://maps.googleapis.com/maps/api/distancematrix/xml?" & url
    Debug.Print urlencode
    oRequest.Open "GET", urlencode, False
    oRequest.send
    If (oRequest.Status <> 200) Then
        Debug.Print "HTTP Status is not OK (200)"
        Debug.Print oRequest.responseText
        RecupTrajet = "Erreur HTTP"
    Else
         Debug.Print oRequest.responseText
         Debug.Print "============================"
         XML = oRequest.responseText
    '     Debug.Print XML
         oXml.LoadXML XML
         Debug.Print oXml.SelectSingleNode("//row/element/status").Text
         If oXml.SelectSingleNode("//row/element/status").Text = "OK" Then
            Debug.Print oXml.SelectSingleNode("//duration/text").Text
            Debug.Print oXml.SelectSingleNode("//distance/text").Text
            Debug.Print "============================"
            RecupTrajet = oXml.SelectSingleNode("//distance/text").Text + "," + oXml.SelectSingleNode("//duration/text").Text
         Else
            RecupTrajet = "Erreur : " + oXml.SelectSingleNode("//row/element/status").Text
         End If
    End If
   Set oXml = Nothing
   Set oRequest = Nothing
End Function

Exemple de code d'appel de la fonction :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub TestRecupTrajet()
Dim rg As Range
Dim r As Long
Dim AdresseDep As String, AdresseDest As String
Dim result() As String
Set rg = Worksheets("Trajets").ListObjects("TableauTrajets").DataBodyRange
For r = 1 To rg.Rows.Count
   AdresseDep = rg(r, 1).value
   AdresseDest = rg(r, 2).value
   result = Split(RecupTrajet(AdresseDep, AdresseDest), ",")
   If UBound(result) = 1 Then
      rg(r, 3).value = result(0)
      rg(r, 4).value = result(1)
   Else
      rg(r, 3).value = result(0)
      rg(r, 4).value = result(0)
   End If
Next
End Sub

Nom : CalculTrajet.gif
Affichages : 119
Taille : 74,3 Ko

Confirmation de la tarification ( 200$ = 40000 requêtes) :
Nom : Tarifs.png
Affichages : 111
Taille : 35,7 Ko

Exemple d'ajustement des quotas :
Nom : Quota.png
Affichages : 112
Taille : 24,6 Ko

Ami calmant, J.P

**laurent_ott** · 23/07/2023, 15h08

Bonjour,
J'ai créé une clé en utilisant ce site : https://developers.google.com/maps/p...?hl=fr#get_key

Mais j'ai dû louper quelque chose car la clé ne marche pas, ça plante sur l'instruction : oXml.SelectSingleNode("//row/element/status").Text
Quand je débug ça me donne ceci :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
? oRequest.responseText
 
<?xml version="1.0" encoding="UTF-8"?>
<DistanceMatrixResponse>
 <status>REQUEST_DENIED</status>
 <error_message>This API project is not authorized to use this API.</error_message>
</DistanceMatrixResponse>

Une idée ?

**jurassic pork** · 23/07/2023, 16h14

hello,
je crois qu'il y a la facturation et l'API à activer voir ici
Sinon pour essayer utiliser un navigateur avec l'url de commande.
Ami calmant, J.P

**laurent_ott** · 23/07/2023, 17h26

Envoyé par jurassic pork

je crois qu'il y a la facturation et l'API à activer voir ici

Sacrée usine à gaz cette histoire de clé, mais bon, ça marche.
Merci pour ce code, une fois de plus très efficace, bravo jurassic pork.

Cordialement.

**jurassic pork** · 24/07/2023, 12h11

Hello Laurent,
pour ne pas avoir de mauvaises surprises n'oublie pas de limiter le nombre de requêtes par jour (accessoirement on peut mettre aussi une alerte par courriel lorsque qe le nombre de requêtes atteint un certain seuil). Si tu te fais pirater ta clé tu n'est plus maître du nombre de requêtes et dès qu'on dépasse le quota de 200$ par mois on doit payer.
Ami calmant, J.P

VBA + Internet (Google Maps ?) : Calcul des kilomètres entre deux adresses [Toutes versions]

Macros et VBA Excel

Discussions similaires

Partager

Partager