Macro pour calculer la distance entre deux villes via google maps

  • Initiateur de la discussion Initiateur de la discussion platina
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

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

J'ai créé une clé API Google et activé l'API Direction mais Excel ne l'identifie pas et me demande toujours de l'activer via le lien en C6, ce qui me redirige vers ma page Google API. Mais ça ne fonctionne pas.
De plus j'avoue ne pas trop comprendre comment ce classeur fonctionne. Si j'ai une ville de départ et une adresse complète d'arriver, est-ce que ça fonctionne ou dois-je forcément lier une ville avec une autre ville et une adresse complète avec une autre adresse complète ?

Merci d'avance
 
Re : Macro pour calculer la distance entre deux villes via google maps

catrice, platina, bonjour,

j'ai adapté l'excellent code de catrice pour l'intégrer dans une boucle en références relatives.

Il est préférable d'utiliser les codes postaux pour les départs et arrivées plutôt que les noms des villes (tu auras plus de résultats corrects

bon courage
Bonjour la macro ne semble pas fonctionner pour moi, il m'est indiqué «itinéraire non trouvé». sauriez vous d'où cela vient? Merci
 
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
Merci !!!!
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
4
Affichages
6 K
Réponses
1
Affichages
2 K
Retour