Macro pour calculer la distance entre deux villes via google maps

[platina]

Bonjour !

Je souhaite créer une macro utilisant google maps pour calculer la distance (via la route, et non à vol d'oiseau) entre deux villes ;
Disons que j'ai le nom ou code postal (ce qui rend la chose la plus simple!) de la première ville en A1 et le nom ou code postal de la seconde ville en A2.
Comment faire pour afficher la distance entre les deux en A3 ?

Merci beaucoup !!

 

[BLAIS]

Bonjour ,
je reviens à nouveau vers vous car j'ai pu faire la modif pour le mois d'octobre et effectivement cela marche bien (quelques villes qu'il ne trouve pas , donc je mets une ville à proximité).
Je rencontre cependant 3 pb :
- J'ai fait effectivement un copier vers le bas cela fonction bien pour la formule =ARRONDI, mais cela ne fonctionne pas avec la formule =SERVICEWEB, il faut que je change systématiquement le nom des cellules (par exemple quand j'ai copier E14 en E15, il a gardé dans la formule E14 donc je dois changer dans =SERVICEWEB le nom de la cellule E14 en E15 et ainsi de suite vers le bas
- Quand j'insert une cellule la formule ne s'applique pas il faut donc que je la recopie, normal ?
- enfin le plus gros pb, les cases non remplies engage un "#valeur# "ce qui squiz tous les cumuls en F10 & 11; G10&11.
Comment faire pour que quand une valeur départ ou destination n'est pas rempli il n'y est pas cet "#valeur# " ?

Je vous remercie de votre retour.
cdt

 

[Alain Goossens]

Bonjour,

Désolé d'insister, je crains que mon message ne soit pas lu.
Quelqu'un peut-il m'aider quant à l'application Excel "Itinéraire GOOGLE Multi Adresses V2.01"?
Je souhaite obtenir la dernière version, je suis nouveau dans la communauté et ne sais comment m'y prendre.
Merci.

 

[BLAIS]

Bonjour,
j'ai donc appliqué à partir du mois d'octobre à mon tableau le calcul de distance entre ville de départ et ville d'arrivée qui marche super bien, par contre je m'appercois que la somme des kms (cellule F10) et donc des IK (cellule G10) ne s'additionnent plus comme il se doit.
quelqu'un peut t'il m'aider ? faut t'il modifier pour novembre & décembre aussi ? pour l'année 2017 je souhaite donc passer par le mode de calcul que sur la feuille d'octobre bcp plus simple puis je faire un copié/collé de la feuille d'octobre sur tous les mois pour avoir les calculs avec ville de départ et d'arrivée et addition des Kms et IK ?

Merci de votre retour.
Cdt

 

[dani80davidoff]

Ce lien n'existe plus - Forum
Comment trouver la Ce lien n'existe plus ou d'autres villes et pays sur une carte du monde.

Profitez de notre calcul de la distance du site - Ce lien n'existe plus
et vous pouvez toujours trouver la distance exacte entre deux villes dans le monde.



Notre calculateur va Ce lien n'existe plus en ligne droite et sur l'autoroute!
En ligne droite - le calcul de la distance est comme si vous voyagez sur un avion.
Sur les routes - notre calculatrice doit toujours choisir la voie la plus optimale par la route.
Marchez - dans ce cas, le calcul de la distance est sur la voie publique.
Sur le vélo - dans ce cas, le calcul de la distance est effectuée sur la voie publique.

Une caractéristique unique de notre calculatrice est qu'il peut calculer un itinéraire que sur les routes libres
dans ce cas, vous ne serez pas besoin de payer pour Voyage sur les routes en Europe
beaucoup de routes à péage, mais il y a des routes libres - cette route ne fera que
les routes sans frais, et vous pouvez économiser de l'argent.

Aussi, vous obtiendrez plus d'informations: temps de Voyage approximative, le prix et la quantité de carburant
que vous prenez cette route, la distance en kilomètres et en miles.

Vous pouvez même créer un itinéraire complexe qui passera uniquement par les villes que vous avez besoin
(Ce qui vous sélectionnez) vous pouvez ajouter jusqu'à 10 villes intermédiaires et votre itinéraire sera construite seulement par ces villes.
dans le calcul du calculateur de distance comporte des champs supplémentaires, vous serez en mesure de
indiquer le nombre de litres de carburant de votre véhicule consomme sur un chemin 100km et préciser le coût du carburant pour 1 litre
indiquer votre mode de conduite de vitesse sur les routes et plus.

Sur une carte géographique du monde, vous verrez un itinéraire détaillé et sera en mesure d'examiner en détail, ainsi que
une carte géographique de la route, vous recevrez des instructions détaillées où vous avez besoin d'aller en voiture et où vous devez tourner les pointeurs vers tous les panneaux de signalisation.

 

[BLAIS]

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.

 

[BLAIS]

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 :

=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]

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

 

[Compte Supprimé 979]

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]

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]

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]

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 ?

 

[Laure3307]

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 :

  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

Lien supprimé


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

 

[dendroidking]

Without a file with the list of your departures and destinations, difficult to know!

 

[guixlsm]

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:

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

 

[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).

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:

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