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

 

[SousouSal]

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]

Bonjour Pierre,
Joyeux Noel

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

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,

 

[Usine à gaz]

Merci Pierre
Bon sang, je n'avais pas trouvé

 

[Jeremtutu]

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]

Bonsoir @Jeremtutu,

En attendant le retour de l'auteur (@tatiak que je salue respectueusement ), essayez le code suivant:

' ***********************************************************************
' *****                                                             *****
' *****        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

 

[Jeremtutu]

Bonsoir @Jeremtutu,

En attendant le retour de l'auteur (@tatiak que je salue respectueusement ), essayez le code suivant:

' ***********************************************************************
' *****                                                             *****
' *****        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]

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.

With CreateObject("WINHTTP.WinHTTPRequest.5.1")
    .Open "GET", Url, False
    .send
    Txt = .responseText
End With

L'un de vous aurait-il des conseils ?

 

[golgue]

Bonjour,
comment calculer une distance en C7avec la ville de repart en B9 et la ville s'arrivée en C8 ?
Je suis complètement nul en macro

 

[mf1608]

Bonjour,
Comment puis-je faire pour avoir le même fichier (calcul des km entre deux code postaux) mais en Belgique ?
Merci d'avance.
Bien à vous.

 

[ClementL07]

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

 

[Compte Supprimé 979]

Bonjour,

Avez-vous essayé ma version qui se trouve ICI

https://www.excel-downloads.com/thr...s-via-google-maps.106712/page-24#post-1040719

A+

 

[mf1608]

Bonjour, j'ai tester le fichier Itinéraire GOOGLE Multi Adresses V2.08 mais lorsque je clic sur calculer itinéraire, (entre deux villes de Belgique + code postal) je n'ai rien qui apparait

 

[Compte Supprimé 979]

@mf1608 pour la Belgique, je ne sais pas si effectivement cela fonctionne
Peux-tu nous donner 2 villes et le code CP

 

[mf1608]

oui voici:
4800 Verviers
4950 Waimes

 

[los66]

Bonjour

' ***********************************************************************
' ***** *****
' ***** CODE PierreP56 : http://tatiak.canalblog.com/
' ***** Modifié pour personnalisation Los66
' ***** \\ avec mes remerciements à PierreP56 // *****
' ***********************************************************************