Macro pour calculer la distance entre deux villes via google maps

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 ?
 

golgue

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

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

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:

mf1608

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

los66

XLDnaute Nouveau
Bonjour

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

BrunoM45

XLDnaute Barbatruc

mf1608

XLDnaute Nouveau
Bonjour mf1608

Désolé, j'avais un petit souci avec ma clé API Google, je ne pouvais pas tester la dernière version :(

Maintenant, c'est chose faite et la dernière version fonctionne également pour nos amis Belge ;)
Voir la pièce jointe 1061022

Dernière version ICI : https://www.excel-downloads.com/thr...s-via-google-maps.106712/page-18#post-1040719

Au plaisir
Bonjour BrunoM45

un grand merci pour ton test. juste une question un peu bête... Il me faut un clé API, mais quelle API dois-je activer au niveau de Google ?

Merci.
Bien à toi.
 

BrunoM45

XLDnaute Barbatruc
?? je propose juste une alternative à ta bonne proposition (mais ici sans clé) et avec l'ajout une carte du chemin à prendre
Si ça gêne, je peux effacer mon message sur simple demande
??
Pierre
Non Pierre, tes contributions sont toujours très enrichissantes...
c'est juste ta façon de faire...
 

PEACHBIRD

XLDnaute Nouveau
Bonjour,

Après avoir lu les nombres page de ce sujet, je n'ai pas trouvé de réponse à mon problème.

Comment faire pour avoir l'affichage en décimal (2 décimal serait parfait) des km ?

Ci-dessous le script adapté à mon fichier.

Merci d'avance pour votre aide.

VB:
'====================
'Calcul des distances
'====================
Option Explicit
Public Const DIST = "http://www.distance2villes.com/recherche?source="
Sub Distance()
    Dim lg As Integer, i As Integer
    Dim Url As String, Txt As String, d, temps

    With Sheets("Facturation")
    ActiveSheet.Unprotect Password:="123"
    lg = .Cells(Rows.Count, 1).End(xlUp).Row
    For i = 17 To lg
        If Range("B" & i).Value <> "" And Range("B" & i).Value <> 0 Then
        Url = DIST & .Range("B" & i).Value & "&destination=" & .Range("C" & i).Value
        With CreateObject("WINHTTP.WinHTTPRequest.5.1")
            .Open "GET", Url, False
            .send
            Txt = .responseText
        End With
        .Range("E" & i).Value = Split(Split(Txt, "id=""distanciaRuta"">")(1), "</strong>")(0)
    'en nombre
        .Range("E" & i).NumberFormat = "##,##"
        .Range("E" & i) = Val(Replace(.Range("E" & i), ",", ""))
    End If
    Next i
    ActiveSheet.Protect Password:="123"
End With
    MsgBox "Le calcul des KMs est terminé !"
End Sub
 

Audreyouyou

XLDnaute Nouveau
Bonjour @BrunoM45 et à tous les autres,
Merci beaucoup pour ton fichier.
J'ai utilisé le mode "Multi-Départs/Multi-Destinations" en rentrant les coordonnées GPS dans chaque feuille. Je suis embêtée car j'ai un message d'erreur qui s'affiche : "erreur d'exécution 438 : propriété ou méthode non gérée par cet objet". C'est la ligne suivante qui est surlignée en jaune dans le code :
Désactiver la checkbox de détail du parcours
CheckBox1.Value = False
Je pense que c'est un truc tout bête que je n'ai pas compris. Si c'est le cas, désolée pour ma question ! Je suis novice en macros et il se peut que j'ai mal compris quelque chose d'élémentaire dans le fonctionnement de ton fichier. J'ai cherché pas mal de temps en essayant de faire les autres modes, de passer par les adresses plutôt que par les points GPS, etc. mais je n'ai rien trouvé qui me permette de savoir ce que je dois faire pour résoudre cette erreur. D'où ce message :)
Bonne soirée,
Audrey
 

BrunoM45

XLDnaute Barbatruc
Bonjour Audrey,
Bonjour @BrunoM45 et à tous les autres,
Merci beaucoup pour ton fichier.
J'ai utilisé le mode "Multi-Départs/Multi-Destinations" en rentrant les coordonnées GPS dans chaque feuille. Je suis embêtée car j'ai un message d'erreur qui s'affiche : "erreur d'exécution 438 : propriété ou méthode non gérée par cet objet". C'est la ligne suivante qui est surlignée en jaune dans le code :
Désactiver la checkbox de détail du parcours
CheckBox1.Value = False
Est-ce bien mon fichier que tu utilises ?
As-tu bien le Checkbox dans la feuille "Itinéraire"
2020-05-10_05h06_23.png

@+
 

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas