Macro pour calculer la distance entre deux villes via google maps

BLAIS

XLDnaute Nouveau
Bonjour,
j'ai de nouveau un pb avec mon tableau, il ne m'additionne plus les cumulés (kms mois, kms année, cout mois, cout année). Pourriez vous m'aider ?
Je vous en remercie.
Bien cordialement.
 

Fichiers joints

tatiak

XLDnaute Barbatruc
Bonjour à tous,

@ Blais : tu commences à être un peu lourd, la solution a déjà été donnée précédemment, en E14 tu colles la formule :
Code:
=SERVICEWEB("https://maps.googleapis.com/maps/api/distancematrix/xml?origins="&C14&"&destinations="&D14&"&mode=driving")
et tu recopies vers le bas

@ Nicolas : ci-après ton fichier modifié avec calcul de la distance. Ça devrait être fonctionnel sous Office 2013.

Pierre
 

Fichiers joints

BLAIS

XLDnaute Nouveau
Bonjour à tous,

@ Blais : tu commences à être un peu lourd, la solution a déjà été donnée précédemment, en E14 tu colles la formule :
Code:
=SERVICEWEB("https://maps.googleapis.com/maps/api/distancematrix/xml?origins="&C14&"&destinations="&D14&"&mode=driving")
et tu recopies vers le bas

Vraiment désolé ,
je viens de m'apercevoir que je n'avait le même tableau en novembre et décembre ce qui expliquait cela.
Je tiens malgré tout à remercier d'avoir tant de patience avec des personnes comme moi.
cdt
 

Laure3307

XLDnaute Nouveau
Re : Macro pour calculer la distance entre deux villes via google maps

Re,

Version 1.5.3
Correction du bug et mise à jour du fichier avec petite modif dans le module "boucle"

Version 2.0.0 :p
- Possibilité de calculer ses itinéraires de 2 facons différentes : par API ou QUERY Google
(Query fonctionne souvent mieux, mais est plus limitée en nombre de requêtes)
- Possibilité de calculer ses itinéraires pour de multi-départs et multi-destinations
- Correction de petis bugs

Version 2.0.1
- Correction du bug de la colonne 'D' il n'est plus nécessaire de la remplir pour que le calcul se fasse
- Correction du bug des accents dans la colonne 'F', la ville est mise en majuscule sans accent
- Ajout du bouton [Multi-itinéraires] permet de calculer un itinéraire pour chaque ligne départ/destination

Version 2.0.2
- Correction du bug "erreur d'éxécution '1004' La méthode select de la classe range à échoué"
- Correction du bug pour les codes postaux commençant par 0
- Modification du code pour adresse introuvable
- Ajout d'un petit mode d'emploi des boutons

Version 2.0.3
- Correction du bug pour durée comprise entre 1 et 2h (je n'ai pas tout testé)

Version 2.0.4
- Ajout de la latitude et longitude (coordonnées GPS) pour tous les types d'itinéraires (seul l'API google le permet)

Version 2.0.5
- Possibilité de calculer son/ces itinéraire(s) via les coordonnées GPS

Version 2.0.6 - Correctifs du 04/02/2014
- Possibilité Multi-destinations sur code postal uniquement
- Correctif de bugs mineurs

Version 2.0.7 - Correctifs du 17/11/2014
- Correction du bug en cas de multi itinéraires en coordonnées GPS
- décodage des caractères UTF-8 en caractères ASCII
Version 2.0.7 - Correctifs du 16/11/2014
- Trouver la ligne de fin de destination si on ne saisi que le nom des villes
Version 2.0.7a - Correctifs du 28/11/2014
- Problème de retour de temps de trajet (merci octu)

Ce fichier ne fonctionne que pour des adresses normales avec un numéro et une rue et/ou un code postal et ville ou des coordonnées GPS correctes

A+





Bonjour BrunoM45,
Malgré de nombreuses tentatives pour trouver l'erreur, j'ai un problème avec cette ligne :
sTmp = ShtS.Range("A" & LigF).Value

J'ai remarqué que ce n'étais pas la première fois que ça arrivait.. Et malgré le téléchargement de la version V2.08.. As tu une solution ?
 

tatiak

XLDnaute Barbatruc
Bonjour Laure,
Juste en passant, ci-joint 2 propositions pour calculer un trajet entre 2 adresses (utilisant les api de google) :
* une démo utilisant 2 formules
* une démo utilisant une sortie json (le calcul se fait après saisie ou modif du départ et/ou arrivée) donnant un trajet google (distance + temps estimé) + un calcul selon points GPS (donc en ligne droite)
Pierre
 

Fichiers joints

BrunoM45

XLDnaute Barbatruc
Bonjour Laure3307

Bonjour BrunoM45,
Malgré de nombreuses tentatives pour trouver l'erreur, j'ai un problème avec cette ligne :
sTmp = ShtS.Range("A" & LigF).Value
J'ai remarqué que ce n'étais pas la première fois que ça arrivait.. Et malgré le téléchargement de la version V2.08.. As tu une solution ?
LigF est une variable qui contient la ligne qui a été trouvée et qui est recherchée plus haut dans le code.
Donc il faudrait que je sache ce qui est cherché ;-)

A+
 

Laure3307

XLDnaute Nouveau
Bonjour Laure,
Juste en passant, ci-joint 2 propositions pour calculer un trajet entre 2 adresses (utilisant les api de google) :
* une démo utilisant 2 formules
* une démo utilisant une sortie json (le calcul se fait après saisie ou modif du départ et/ou arrivée) donnant un trajet google (distance + temps estimé) + un calcul selon points GPS (donc en ligne droite)
Pierre

Merci pour tes propositions, je les ai survolé car je préfèrerai débloquer mon problème, mais je reviendrai vers toi si j'ai des questions.
Bonne journée
 

Laure3307

XLDnaute Nouveau
Bonjour Laure3307


LigF est une variable qui contient la ligne qui a été trouvée et qui est recherchée plus haut dans le code.
Donc il faudrait que je sache ce qui est cherché ;-)

A+
Merci pour ta réponse, je pense que te joidre le fichier ne sert à rien..
J'utilise la macro avec la recherche "multi-destinations". J'ai, pour l'instant, seulement 10 villes en destination (LILLE, MERIGNAC, PESSAC, PARIS, MARSEILLE, LYON, TOULOUSE, TOURS et ANGERS) écrites en majuscule et sans accent. La ville de départ change constamment.
Est ce que le problème peut venir du fait que j'utilise ce logiciel à partir d'un autre fichier excel avec Application.Run :
Application.Run "'Classeur1.xlsm'!GestionMulti.Multi_Destinations"
(Classeur1 étant Itinéraire GOOGLE Multi Adresses V2.08.xlsm)

Merci
 

Laure3307

XLDnaute Nouveau
Bonjour Laure,
Juste en passant, ci-joint 2 propositions pour calculer un trajet entre 2 adresses (utilisant les api de google) :
* une démo utilisant 2 formules
* une démo utilisant une sortie json (le calcul se fait après saisie ou modif du départ et/ou arrivée) donnant un trajet google (distance + temps estimé) + un calcul selon points GPS (donc en ligne droite)
Pierre
Finalement j'utilise la démo utilisant une sortie json et c'est vraiment top !! Merci !
Juste une question qui va te paraître toute bête.. Les villes de départ sont "entrées par défault" et si A2 est vide et que A3=A2 alors il est marqué "Județ d'Olt, Roumanie". Comment faire pour l'enlever ?
 

tatiak

XLDnaute Barbatruc
Finalement j'utilise la démo utilisant une sortie json et c'est vraiment top !! Merci !
Juste une question qui va te paraître toute bête.. Les villes de départ sont "entrées par défault" et si A2 est vide et que A3=A2 alors il est marqué "Județ d'Olt, Roumanie". Comment faire pour l'enlever ?
Bonjour Laure,

Il n'y a pas de question bête.

En revanche avec mes tests (sous office 2016):
* si A2 est vide et B2=ville quelconque => C2, D2, E2 sont vides
* si A2=ville quelconque et B2 est vide => C2, D2, E2 sont vides
* si A2 est vide et B2 est vide => C2 = 0, D2 = 0, E2 = 0:00

Maintenant, si le besoin est de calculer depuis (ou vers) une ville contenant une apostrophe, il est nécessaire de compléter le code function Ote_accents => ajouter à la fin :
VB:
  S = Replace(S, "'", " ")
  Ote_accents = S ' ligne déjà existante
A noter : pour certaines villes dont le nom contient des lettres spéciales (cf le t avec un point au dessous dans 'Județ d'Olt, Roumanie'), il est nécessaire de subsituer 'à la main' ces lettres avec son équivalent (ț=>t) sans ces signes particuliers

http://www.hostingpics.net/viewer.php?id=119793Capture.gif


Je ne sais pas si j'ai répondu à la question (?) (en fait, je ne sais même pas si j'ai bien compris la question:confused:)
Pierre
 

Fichiers joints

Laure3307

XLDnaute Nouveau
Bonjour Laure,

Il n'y a pas de question bête.

En revanche avec mes tests (sous office 2016):
* si A2 est vide et B2=ville quelconque => C2, D2, E2 sont vides
* si A2=ville quelconque et B2 est vide => C2, D2, E2 sont vides
* si A2 est vide et B2 est vide => C2 = 0, D2 = 0, E2 = 0:00

Maintenant, si le besoin est de calculer depuis (ou vers) une ville contenant une apostrophe, il est nécessaire de compléter le code function Ote_accents => ajouter à la fin :
VB:
  S = Replace(S, "'", " ")
  Ote_accents = S ' ligne déjà existante
A noter : pour certaines villes dont le nom contient des lettres spéciales (cf le t avec un point au dessous dans 'Județ d'Olt, Roumanie'), il est nécessaire de subsituer 'à la main' ces lettres avec son équivalent (ț=>t) sans ces signes particuliers

http://www.hostingpics.net/viewer.php?id=119793Capture.gif


Je ne sais pas si j'ai répondu à la question (?) (en fait, je ne sais même pas si j'ai bien compris la question:confused:)
Pierre
Super ! Merci pour toutes tes explications, ça m'a bien servi ! En revanche tu n'as pas répondu à ma question.. Peut être n'avais tu pas le problème sous Excel 2016.. mais je me suis débrouillée et tout marche !
Bonne journée
 

guixlsm

XLDnaute Nouveau
Bonjour à tous,

J'ai repris la macro du fichier Json que j'ai intégré à un autre fichier. Ce fichier vient automatiquement copier les points de départ et d'arrivée, puis je lance la macro pour aller chercher les distances. L'extraction se fait correctement pendant une période.

A un moment donné (que je n'arrive pas à identifier), la macro devient inutilisable. Elle extrait les bons noms de villes dans gmaps, avec les codes postaux, mais elle me note les distances et les temps à 0. et 0:00.

je pense que ce n'est pas une question de limite d'utilisation puisque je peux toujours extraire ces distances sur des versions précédentes du fichiers, ou sur la version DémoJson.xlsm par exemple.

Est ce que quelqu'un rencontre le même problème? Si oui est ce que quelqu'un a réussi à traiter le problème?

Merci d'avance,

Guillaume

PS: J'utilise ce code d'une version précédente, qui passe par un bouton et est moins complexe à transposer dans un autre fichier que la dernière version qui met à jour les distances automatiquement:

Code:
Option Explicit

Public ScriptControl As Object

Public Type deAaB
    ptA As String
    ptB As String
    dist As Single
    duree As Single
End Type


Sub Serie()

Dim Tdata As Variant, lg As Long, i As Long
Dim Trajet As deAaB

    With Sheets("Gmaps")
        lg = .Cells(Rows.Count, "A").End(xlUp).Row
        Tdata = .Range(.Cells(2, "A"), .Cells(lg, "D")).value

        For i = 1 To lg - 1
            Trajet = AversB(Ote_accents(Tdata(i, 1)), Ote_accents(Tdata(i, 2)))
            Tdata(i, 1) = Trajet.ptA
            Tdata(i, 2) = Trajet.ptB
            Tdata(i, 3) = 1 * Format(Trajet.dist, "# ###.00")
            Tdata(i, 4) = Trajet.duree
        Next i
   
        .Range("A2").Resize(UBound(Tdata, 1), UBound(Tdata, 2)) = Tdata
    End With
   
End Sub


' ***** FONCTIONS *********************************************************************************
Function Ote_accents(Sv As Variant) As String
Dim S As String

    S = CStr(Sv)
    S = Replace(S, "â", "a")
    S = Replace(S, "à", "a")
    S = Replace(S, "ä", "a")
    S = Replace(S, "ê", "e")
    S = Replace(S, "é", "e")
    S = Replace(S, "è", "e")
    S = Replace(S, "ë", "e")
    S = Replace(S, "ï", "i")
    S = Replace(S, "ô", "o")
    S = Replace(S, "ö", "o")
    S = Replace(S, "û", "u")
    S = Replace(S, "ù", "u")
    S = Replace(S, "ü", "u")
    S = Replace(S, "'", " ")
    Ote_accents = S
   
End Function


Function AversB(A As String, B As String) As deAaB
Dim Depart As String, Arrivee As String, Site As String
Dim Json As Object, Elem As Object, Elem1 As Object
Dim ok As Boolean

    With Sheets("Gmaps")
        Depart = Ote_accents(A)
        Arrivee = Ote_accents(B)
       
        On Error Resume Next
        Site = "https://maps.googleapis.com/maps/api/distancematrix/json?origins=" & _
                Depart & "&destinations=" & Arrivee & "&mode=driving&language=fr-FR"
        Set Json = oRecordSet(Site)

        For Each Elem In Json.Rows
            For Each Elem1 In Elem.elements
                ok = Not (Elem1.status = "ZERO_RESULTS")
                AversB.dist = Elem1.distance.value / 1000
                AversB.duree = Elem1.duration.value / 24 / 60 / 60
            Next Elem1
        Next Elem

        ScriptControl.AddCode "Object.prototype.item=function( i ) { return this[i] } ; "
        AversB.ptA = Json.origin_addresses.item(0)
        AversB.ptB = Json.destination_addresses.item(0)

        If Not ok Then
            AversB.dist = 0
            AversB.duree = 0
        End If

        Set Json = Nothing
    End With
   
End Function


Function oRecordSet(txt As String, Optional www As Boolean = True) As Object
Dim Html As Object, Obj As Object, S As String

    Set ScriptControl = CreateObject("MSScriptControl.ScriptControl")
    ScriptControl.Language = "JScript"
   
    If www Then
        Set Html = CreateObject("MSXML2.XMLHTTP")
        With Html
            .Open "GET", txt, False
            .send
            S = .responsetext
        End With
    Else
        S = txt
    End If
   
    Set Obj = ScriptControl.Eval("(" & S & ")")
    Set oRecordSet = Obj
    Set Obj = Nothing
   
End Function
 
Dernière édition:

tatiak

XLDnaute Barbatruc
Bonjour Guixlsm,

Juste une remarque : dans DémoJson.xlsm l'interrogation du site Google se fait une ligne par une ligne (avec un temps de saisie entre chaque). Dans le code que tu indiques, tu lances une série d'interrogations.
Si l'interrogation 'unique' fonctionne dans DémoJson.xlsm, on peut en déduire que les adresses saisies sont correctement lues par Google.
Si la série d'interrogations coince à un moment, je pencherai donc plus pour une question de limite du côté du serveur Google (cf => https://developers.google.com/maps/documentation/geocoding/usage-limits?hl=FR)

Pour identifier le moment 'critique' insère donc par exemple un debug.print i & "-" & Trajet.duree à la fin de la boucle For i = 1 To lg - 1 (avant le next i), et indique-nous le i de la première ligne affichée avec un Trajet.duree=0 dans le debug (bingo si =50).

Pierre
 

guixlsm

XLDnaute Nouveau
Juste une remarque : dans DémoJson.xlsm l'interrogation du site Google se fait une ligne par une ligne (avec un temps de saisie entre chaque). Dans le code que tu indiques, tu lances une série d'interrogations.
Si l'interrogation 'unique' fonctionne dans DémoJson.xlsm, on peut en déduire que les adresses saisies sont correctement lues par Google.
Si la série d'interrogations coince à un moment, je pencherai donc plus pour une question de limite du côté du serveur Google (cf => https://developers.google.com/maps/documentation/geocoding/usage-limits?hl=FR)

Pour identifier le moment 'critique' insère donc par exemple un debug.print i & "-" & Trajet.duree à la fin de la boucle For i = 1 To lg - 1 (avant le next i), et indique-nous le i de la première ligne affichée avec un Trajet.duree=0 dans le debug (bingo si =50).
Bonjour tatiak,

Merci pour la rapidité de ta réponse,

C'est ce que je pensais aussi au départ pour les limites d'utilisation, mais j'ai essayé d'utiliser le fichier ce matin en arrivant. La limite est journalière et logiquement, si le problème avait été celui là, l'extraction aurait dû fonctionner,

j'ai fait les manip que tu m'as conseillé et la durée du trajet se transforme en "VRAI", et non pas en 50. Je ne suis pas très avancé (je touche aux macros depuis quelques mois par intermittence pour apporter des améliorations et faire des fichiers de travail)

Est-ce que la manip a été bien réalisée, et quelle est la signification de VRAI?

De A Distance trajet (km) Durée trajet (h:mm)
34800 Clermont-l'Hérault, France Nantes, France 0 VRAI
34800 Clermont-l'Hérault, France Reims, France 0 VRAI
34800 Clermont-l'Hérault, France 47260 Castelmoron-sur-Lot, France 0 VRAI
Bout de code:
Code:
Sub Serie()

Dim Tdata As Variant, lg As Long, i As Long
Dim Trajet As deAaB

    With Sheets("Gmaps")
        lg = .Cells(Rows.Count, "A").End(xlUp).Row
        Tdata = .Range(.Cells(2, "A"), .Cells(lg, "D")).value

        For i = 1 To lg - 1
            Trajet = AversB(Ote_accents(Tdata(i, 1)), Ote_accents(Tdata(i, 2)))
            Tdata(i, 1) = Trajet.ptA
            Tdata(i, 2) = Trajet.ptB
            Tdata(i, 3) = 1 * Format(Trajet.dist, "# ###.00")
            Tdata(i, 4) = Trajet.duree = 0
   
' MAJ Tatiak internet
    Debug.Print i & "-" & Trajet.duree
'
        Next i
Guillaume
 

tatiak

XLDnaute Barbatruc
Oulà, ben non il fallait écrire dans le code :
VB:
        For i = 1 To lg - 1
            Trajet = AversB(Ote_accents(Tdata(i, 1)), Ote_accents(Tdata(i, 2)))
            Tdata(i, 1) = Trajet.ptA
            Tdata(i, 2) = Trajet.ptB
            Tdata(i, 3) = 1 * Format(Trajet.dist, "# ###.00")
            Tdata(i, 4) = Trajet.duree
            debug.print i & "-" & Trajet.duree
        Next i
et le résultat dans la fenêtre du debug du code (Ctrl+G => fenêtre d'exécution) devrait être du type : x-0
(x étant l'indice de la ligne à partir de laquelle ça coince)

Pierre
 

guixlsm

XLDnaute Nouveau
Ah d'accord, merci. Je viens de tester ça, Ca commence à 128-0, mais les 128 premières ligens n'ont pas de distances ni de temps qui s'affichent quand même
 

philppe27

XLDnaute Occasionnel
Bonjour à tous, je ressors cette discussion car j'aurais besoin d'une info complémentaire qui sauf erreur de ma part ne s'y trouve pas.
Dans le fichier un peu plus haut calculdomicile_travail.xlsx on trouve 2 formules :

=SERVICEWEB("https://maps.googleapis.com/maps/api/distancematrix/xml?origins="&B2 & " " &C2&"&destinations="&F2 & " " &G2&"&mode=driving")
=SI(ESTNA(I2);"";ARRONDI(FILTRE.XML(I2;"/DistanceMatrixResponse/row/element/distance/value")/1000;1))

qui permettent de calculer facilement la distance entre 2 villes dans googlemaps.
Peut-on modifier le chemin et les formules pour obtenir le temps nécessaire en voiture ?

Merci d'avance pour vos réponses
 

philppe27

XLDnaute Occasionnel
Bon finalement, j'ai fini par trouver... !
Il suffit dans la 2ème formule de substituer "distance" par "duration" et de remplacer 1000 par 3600 pour obtenir le temps en heures
 

Fredjo999

XLDnaute Nouveau
Bonjour à toutes et tous,

J'ai parcouru la discussion avec un intérêt énorme !
En effet, j'aimerais pouvoir disposer d'un tel calcul dans excel (calcul de km d'adresse exacte à adresse exacte).

J'ai essayé les différents fichiers mais rien ne semble fonctionner chez moi... on dirait clairement que Excel n'arrive pas à faire la requête sur Google Maps.. Est-ce que je dois paramétrer quelque chose dans mon Office Excel (365) ??

Merci d'avance pour votre retour et désolé si c'est une question déjà posée.. je n'ai pas trouvé :oops:
 

Discussions similaires


Haut Bas