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

SousouSal

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

Catrice ! C'est super ça marche !!!

Bravo, tu m'as gagné des heures de google maps ! En fait je dois faire cela sur 7000 villes !
Donc comment adapter ton fichier pour que si j'ai tous mes départs dans la colonne A, et toutes mes arrivées dans la colonne B, obtenir toutes les distances en km dans la colonne C sans cliquer 7000 fois sur la touche grise ?

Merci beaucoup !
Bonjour,

J'ai essayé avec excel 2013, mais j'obtiens sur la feuille 2 un message qui me demande d'activer Javascript!!!!!
 

Usine à gaz

XLDnaute Barbatruc
Supporter XLD
Bonjour Pierre,
Joyeux Noel :)

Super ton fichier, merci.
J'aimerais bien l'intégrer dans mon fichier de travail.
distance.jpg

Mais, comme d'hab, j'aurais besoin d'une adaptation que je n'arrive pas à faire :
Tjrs une seule recherche de km (recherche donc uniquement M2 > M3
Je saisie toujours la ville de départ en M2, la ville de destination en M3
la cellule de destination km est Q2

Si c'est facile et rapide, peux-tu me modifier ton code ?
Un grand merci par avance
Amicalement,
lionel,
 

Jeremtutu

XLDnaute Nouveau
Bonjour à tous,

Voici une proposition alternative pour calculer la distance par route entre 2 villes (sans clé, sans API, sans CB, sans javascript, sans blabla)

Fonctionne avec Excel 2016, pour les autres versions je ne sais pas

Pierre
Bonsoir,
Le fichier est vraiment parfait. Comment peut-on récupérer le temps de trajet entre les deux villes ? Le fichier est top pour la distance kilométrique mais je n'arrive pas à chercher le temps de trajet. Merci d'avance !
 

mapomme

XLDnaute Barbatruc
Supporter XLD
Bonsoir @Jeremtutu,

En attendant le retour de l'auteur (@tatiak que je salue respectueusement :)), essayez le code suivant:
VB:
' ***********************************************************************
' *****                                                             *****
' *****        CODE PierreP56 : http://tatiak.canalblog.com/        *****
' *****                                                             *****
' ***********************************************************************
' >>>>>>>>>>>> modifié par mapomme
' ***********************************************************************

Public Const DIST = "http://www.distance2villes.com/recherche?source="

Sub Distance()
Dim lg As Integer, i As Integer, j&
Dim Url As String, Txt As String, d, temps

   With Sheets("Feuil1")
      lg = .Cells(Rows.Count, 1).End(xlUp).Row
      For i = 2 To lg
         Url = DIST & .Range("A" & i).Value & "&destination=" & .Range("B" & i).Value
         With CreateObject("WINHTTP.WinHTTPRequest.5.1")
            .Open "GET", Url, False
            .send
            Txt = .responseText
         End With
         .Range("C" & i).Value = Split(Split(Txt, "id=""distanciaRuta"">")(1), "</strong>")(0)
         ' en nombre
         .Range("C" & i).NumberFormat = "#,##0"
         .Range("C" & i) = Val(Replace(.Range("C" & i), ",", ""))
         ''.Range("d" & i).Value = Split(Split(Txt, """tiempo"">")(1), "</")(0)
         d = Application.Trim(Split(Split(Txt, """tiempo"">")(1), "</")(0)) & "    "
         temps = 0
         If InStr(d, "d") > 0 Then
            temps = Val(d)
            d = Mid(Mid(d, InStr(d, "d")), InStr(Mid(d, InStr(d, "d")), " ") + 1)
         End If
         If InStr(d, "h") > 0 Then
            temps = temps + Val(d) / 24
            d = Mid(Mid(d, InStr(d, "h")), InStr(Mid(d, InStr(d, "h")), " ") + 1)
         End If
         If InStr(d, "m") > 0 Then
            temps = temps + Val(d) / (60 * 24)
         End If
         .Range("d" & i).NumberFormat = "[hh]:mm"
         .Range("d" & i) = temps
      Next i
   End With
End Sub
 

Pièces jointes

  • tatiak- Distances_entre_2villes (et durée)- v1.xlsm
    20.6 KB · Affichages: 180
Dernière édition:

Jeremtutu

XLDnaute Nouveau
Bonsoir @Jeremtutu,

En attendant le retour de l'auteur (@tatiak que je salue respectueusement :)), essayez le code suivant:
VB:
' ***********************************************************************
' *****                                                             *****
' *****        CODE PierreP56 : http://tatiak.canalblog.com/        *****
' *****                                                             *****
' ***********************************************************************
' >>>>>>>>>>>> modifié par mapomme
' ***********************************************************************

Public Const DIST = "http://www.distance2villes.com/recherche?source="

Sub Distance()
Dim lg As Integer, i As Integer, j&
Dim Url As String, Txt As String, d, temps

   With Sheets("Feuil1")
      lg = .Cells(Rows.Count, 1).End(xlUp).Row
      For i = 2 To lg
         Url = DIST & .Range("A" & i).Value & "&destination=" & .Range("B" & i).Value
         With CreateObject("WINHTTP.WinHTTPRequest.5.1")
            .Open "GET", Url, False
            .send
            Txt = .responseText
         End With
         .Range("C" & i).Value = Split(Split(Txt, "id=""distanciaRuta"">")(1), "</strong>")(0)
         ' en nombre
         .Range("C" & i).NumberFormat = "#,##0"
         .Range("C" & i) = Val(Replace(.Range("C" & i), ",", ""))
         ''.Range("d" & i).Value = Split(Split(Txt, """tiempo"">")(1), "</")(0)
         d = Application.Trim(Split(Split(Txt, """tiempo"">")(1), "</")(0)) & "    "
         temps = 0
         If InStr(d, "d") > 0 Then
            temps = Val(d)
            d = Mid(Mid(d, InStr(d, "d")), InStr(Mid(d, InStr(d, "d")), " ") + 1)
         End If
         If InStr(d, "h") > 0 Then
            temps = temps + Val(d) / 24
            d = Mid(Mid(d, InStr(d, "h")), InStr(Mid(d, InStr(d, "h")), " ") + 1)
         End If
         If InStr(d, "m") > 0 Then
            temps = temps + Val(d) / (60 * 24)
         End If
         .Range("d" & i).NumberFormat = "[hh]:mm"
         .Range("d" & i) = temps
      Next i
   End With
End Sub

Bonsoir,
Le système fonctionne parfaitement avec les distances et le temps. Merci infiniment pour votre aide !
 

mfou007

XLDnaute Nouveau
Bonjour,

Effectivement, j'ai testé sur un ordinateur sous window pas de soucis, par contre sur mac il se trouve qu'il y a un soucis avec la librairie objet.
J'ai fais quelques recherches pour essayer de contourner le problème mais sans succès…
Voici deux forums qui parle de ce soucis :
Lien 1
Lien 2

En fait, j'ai du mal à comprendre la partie ci-dessous, pour pouvoir transposer.
VB:
With CreateObject("WINHTTP.WinHTTPRequest.5.1")
    .Open "GET", Url, False
    .send
    Txt = .responseText
End With

L'un de vous aurait-il des conseils ?
 

ClementL07

XLDnaute Nouveau
Bonjour,

Le système Mapomme et tatiak est top mais malheureusement inutilisable quand on a 500 destinations. En effet, pour de nombreuses destinations (environ 1/4), il me prend une ville du même nom mais à l'autre bout de la france. J'ai essayé de concatener ville + code postal, mais rien à faire, il ne comprend toujours pas...
 
Dernière édition:

Discussions similaires

Réponses
3
Affichages
274

Statistiques des forums

Discussions
311 740
Messages
2 082 047
Membres
101 880
dernier inscrit
Anton_2024