Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Macro pour calculer la distance entre deux villes via google maps

platina

XLDnaute Nouveau
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

XLDnaute Nouveau
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
 

Pièces jointes

  • IK MIS A JOUR.xlsx
    102.8 KB · Affichages: 174

Alain Goossens

XLDnaute Nouveau
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

XLDnaute Nouveau
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
 

Pièces jointes

  • IK MIS A JOUR.xlsx
    103 KB · Affichages: 186

dani80davidoff

XLDnaute Nouveau
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

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.
 

Pièces jointes

  • IK MIS A JOUR.xlsx
    106.2 KB · Affichages: 360

BLAIS

XLDnaute Nouveau
 

Laure3307

XLDnaute Nouveau






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

Compte Supprimé 979

Guest
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+
 

Laure3307

XLDnaute Nouveau


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

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

XLDnaute Nouveau

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:

guixlsm

XLDnaute Nouveau

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
 

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…