Calcul distances avec nouveau lien Google Maps

Bonjour,

Etant donné que Google veut stopper l'ancienne version de Google Maps, il me faut adapter une requête avec la nouvelle version. Or je n'y comprend rien pour le moment

L'objectif est de déterminer la distance entre deux points à partir du nouveau lien url Maps.

En lançant la macro avec le nouveau lien Maps, j'ai un problème à ce niveau

 .Refresh BackgroundQuery:=False

Voir en bas de la macro ci-dessous.

'// On fait la requête avec l'autre adresse

With Sheets("Temp").QueryTables.Add(Connection:="URL;" & adresse, Destination:=Sheets("Temp").Range("A1"))

.Name = "itinéraire"

.BackgroundQuery = True

.WebSelectionType = xlEntirePage

.WebFormatting = xlWebFormattingNone

.Refresh BackgroundQuery:=False

End With

[/code]

Un grand merci pour celui ou celle qui vient à mon aide !!

Matthieu

bonjour,

quelle URL utilises-tu ? en d'autres termes, que contient la variable adresse ?

as-tu essayé en enlevant la ligne qui pose problème ?

En retirant la ligne qui pose problème, j'ai comme résultat -1 ?!

Pour l'adresse Url:

Public Function short_url(adresse As String) As String

'// utilise l'adresse http://tinyurl.com/api-create.php?url=
Const UrlShortener = "http://tinyurl.com/api-create.php?url="

re-bonjour,

que contient la variable adresse ?

sinon mets-nous ton fichier.

Ok, ci-joint le fichier en PJ.

Onglet Distances > dans la colonne Liens G. Map, il faut renseigner le lien Google Maps entre les 2 points. voir exemple

Après il s'agit de lancer la macro (bouton Extraction des distances)

Cela doit permettre d'alimenter la colonne Distances.

après avoir jeté rapidement un oeil sur ton fichier, je vois qu'il s'agit d'un projet avec un code conséquent que je n'ai pas l'intention d'essayer de comprendre. Le mieux serait peut-être de prendre contact avec celui qui a développé cette macro.

J'ai développé in illo tempore une macro qui permet de retrouver le temps et la distance entre 2 points.

voir ici

https://forum.excel-pratique.com/excel/recherche-de-distances-kilometriques-google-maps-ou-autre-t60313.html

Bonjour,

J'ai conservé uniquement le code "Distances" qui ne fait appel à rien d'autres dans le code.

Impossible de prendre contact avec le développeur de cette macro.

Si vous avez une idée, je vous en remercie par avance.

Bonjour,

je t'ai crée une macro newdistance qui utilise le code que j'avais proposé.

ce code suppose l'introduction d'une adresse de départ et de destination valables en colonne K et L. et d'activer la référence à la librairie microsoft xml 3.0.

Sub newdistance()
Dim d As Long
Dim t As Long
Dim i
i = 2
While Cells(i, 1) <> ""

frain = Cells(i, "K")
If frain <> "" Then
'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")
toain = Cells(i, "L")
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")
Cells(i, "E") = d / 1000
Cells(i, "E").NumberFormat = "0.0"
Cells(i, "f") = t / 86400
Cells(i, "F").NumberFormat = "hh:mm"
i = i + 1
End If
Wend
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
   ' <!-- e --><a href="mailto:eric.de.schrevel@gmail.com">eric.de.schrevel@gmail.com</a><!-- e -->

    ' 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

Merci pour tes réponses rapides.

Par contre on ne peut pas renseigner uniquement un point de départ et d'arrivée, car nous forçons le trajet ou itinéraire via Google Maps (avec des points intermédiaires par exemple).

C'est pour cela que nous récupérons ensuite le lien Google Maps dans le fichier excel qui vient pointer sur l'itinéraire défini.

re-Bonjour,

je ne vais malheureusement pas pouvoir te proposer plus que ce que j'ai fait. l'url dépasse la limite des 218 caractères admis par le webquery. Si quelqu'un d'autre à une idée...