Recherche de distances kilométriques - Google Maps ou autre Le sujet est résolu

Y compris Power BI, Power Query et toute autre question en lien avec Excel
Avatar du membre
Yvouille
Passionné d'Excel
Passionné d'Excel
Messages : 9'022
Appréciations reçues : 79
Inscrit le : 6 avril 2007
Version d'Excel : 2016

Message par Yvouille » 30 janvier 2015, 10:45

Bonjour,

Savez-vous s’il existe la possibilité au travers d’Excel d’aller chercher la distance kilométrique entre deux localités ou adresses sur des sites comme Google Maps (de préférence) ou autre ?

Si oui, comment est-ce que ça fonctionne au niveau d’un fichier Excel ?

Cordialement.
Yvouille

Valais de Coeur
h
h2so4
Passionné d'Excel
Passionné d'Excel
Messages : 8'978
Appréciations reçues : 359
Inscrit le : 16 juin 2013
Version d'Excel : 365 UK Windows 10

Message par h2so4 » 30 janvier 2015, 11:06

bonjour,

un exemple :

attention google limite le nombre d'appels que tu peux faire par minute et par jour. si tu veux en faire un usage intensif il faudra payer google.
Sub test()
Dim d As Long
Dim t As Long
frain = InputBox("point de départ (gps (lat, long) ou adresse")
fra = Replace(frain, " ", "+")
toain = InputBox("point d'arrivée (gps (lat, long) ou adresse")
toa = Replace(toain, " ", "+")
Call GoogleGetRoute(fra, toa, d, t)
MsgBox "de " & frain & " à " & toain & vbCrLf & "distance : " & Format(d / 1000, "0.0") & " km, durée : " & Format(t / 86400, "hh:mm")
End Sub

Public Sub GoogleGetRoute(ByVal Fromaddr As String, ByVal Toaddr As String, ByRef rdistance As Long, ByRef rtime As Long, Optional ByVal traceon As Boolean = False)
    ' Eric De Schrevel 2013, merci de laisser cette référence si vous utilisez ce code
    ' eric.de.schrevel@gmail.com
    
    ' rajouter la référence à microsoft xml 3.0, via le menu developer Tools pour que ceci fonctionne
    Dim request As MSXML2.XMLHTTP
    Dim xmlresponse As MSXML2.DOMDocument
    Dim leg As IXMLDOMNode
    Dim googleurl As String
    Dim ctr As Integer
    rdistance = -1:  'pas parvenu à calculer la distance
    rtime = 0
    googleurl = "http://maps.google.com/maps/api/directions/xml?sensor=false&mode=DRIVING&origin=" & Fromaddr & "&destination=" & Toaddr

    Set request = New MSXML2.XMLHTTP
    responsestatus = ""
    While responsestatus <> "OK"
    
    request.Open "GET", googleurl, False
    request.send
    
    If traceon Then MsgBox request.responseText
    
    Set xmlresponse = request.responseXML
    responsestatus = xmlresponse.SelectSingleNode("DirectionsResponse/status").Text
     If responsestatus = "OK" Then
      ctr = 0
      Set leg = xmlresponse.SelectSingleNode("DirectionsResponse/route/leg")
      If Not (leg Is Nothing) Then
        rtime = CLng(leg.SelectSingleNode("duration/value").Text) ' en secondes
        rdistance = CLng(leg.SelectSingleNode("distance/value").Text) 'en mètres
      End If
     Else
      'limite à 2500 consultations de route par jour
      'cfr developers.google.com/maps/documentation/directions
      ctr = ctr + 1
      If responsestatus = "OVER_QUERY_LIMIT" Then
       Application.Wait Time + TimeSerial(0, 0, 1)
      Else
       ctr = 3
      End If
      If ctr = 3 Then MsgBox ("erreur " & responsestatus): responsestatus = "OK"
     End If
    Wend
Set leg = Nothing
Set xmlresponse = Nothing
Set request = Nothing
End Sub
Modifié en dernier par h2so4 le 30 janvier 2015, 12:21, modifié 1 fois.
Avatar du membre
Yvouille
Passionné d'Excel
Passionné d'Excel
Messages : 9'022
Appréciations reçues : 79
Inscrit le : 6 avril 2007
Version d'Excel : 2016

Message par Yvouille » 30 janvier 2015, 12:03

Salut H2so4,

Ton code fonctionne à merveille, merci beaucoup pour ta réponse :)

J’ai transformé un tout petit peu ton code afin de l’adapter à mon fichier ; j’y ai notamment ajouté la référence ‘Suisse’ directement dans le code afin de ne pas devoir la saisir à chaque fois. Ca fonctionne bien.

Juste pour une référence, j’arrive à trouver une solution en passant directement par le site Google alors que ta macro ne trouve pas de solution. As-tu une idée pourquoi ? C’est la référence ‘Le Châble, Bagnes’ qui crée des problèmes dans Excel. Ce n’est pas trop gênant, je pourrais sans problème trouver une solution de rechange ; c’est plus par curiosité que je te pose cette question.

Encore merci pour ton aide.

Amicalement.
30.01.png
30.01.png (78.42 Kio) Vu 5223 fois
Distances kilométriques.xls
(48 Kio) Téléchargé 1113 fois
Yvouille

Valais de Coeur
h
h2so4
Passionné d'Excel
Passionné d'Excel
Messages : 8'978
Appréciations reçues : 359
Inscrit le : 16 juin 2013
Version d'Excel : 365 UK Windows 10

Message par h2so4 » 30 janvier 2015, 12:27

Bonjour,

il s'agit d'un problème avec les caractères spéciaux. ton "â" doit être remplacé par son code %E2.

j'ai trouvé une table des codes ici

http://www.degraeve.com/reference/urlencoding.php

ps si tu essaies sans l'accent il trouve bien un chemin de 500 m
Modifié en dernier par h2so4 le 30 janvier 2015, 14:30, modifié 1 fois.
Avatar du membre
Yvouille
Passionné d'Excel
Passionné d'Excel
Messages : 9'022
Appréciations reçues : 79
Inscrit le : 6 avril 2007
Version d'Excel : 2016

Message par Yvouille » 30 janvier 2015, 14:27

Il trouve un chemin de 500 m OK, mais de combien de minutes :D :D

Merci infiniment pour ta réponse claire et complète.

Excellente fin de journée.
Yvouille

Valais de Coeur
Avatar du membre
Steelson
Fanatique d'Excel
Fanatique d'Excel
Messages : 13'502
Appréciations reçues : 752
Inscrit le : 13 octobre 2014
Version d'Excel : 2013 FR
Téléchargements : Mes applications

Message par Steelson » 16 octobre 2018, 02:58

Bonjour,

malheureusement ce genre de requête est aujourd'hui systématiquement bloquée par google qui demande l'activation d'une clé d'accès à ses services
Capture d’écran (206).png
j'ai posté sur un autre sujet une solution de contournement, en attendant de l'améliorer encore si besoin
viewtopic.php?p=696880#p696880

O.o°• ♪♪♫ °º¤ø,¸¸,ø¤º°`°º¤ø,¸ O.o°• ♪♪♫ °º¤ø,¸¸,ø¤º°`°º¤ø,¸
PI = 3.14159 26535 89793 23846 26433 83279 50288 41971 69399 37510 58209 74944 59230 78164 06286 20899 86280

( ͡• ͜ʖ ͡• )
Répondre Sujet précédentSujet suivant
  • Sujets similaires
    Réponses
    Vues
    Dernier message