Calcul distance (Km) entre plusieurs points

Bonjour,

J’ai un fichier avec divers adresse à parcourir en voiture. calcul-distance.xlsm (89,4 Ko)
L’idée est de calculer la distance total parcouru avec les diverses adresses de la même ligne, uniquement si on active la commande à l’aide d’un bouton. Comme ça on évite les requêtes automatiques pour ne pas dépasser le quota gratuit.

Dans cette liste, les adresses s’ajoute via un autre formulaire de saisie, mais là vous avez juste la feuille des divers départs et destinations.

J’ai vu des heures et des heures de vidéo et de forum d’explication sur le fonctionnement, mais sans résultat.

On parle d’utiliser les fonctions suivante:

  • formule « =serviceweb »
  • Power query
  • json
  • xml

J’ai déjà un compte google cloud avec l’API Distance Matrix d’activé et lu au mieux la documentation (https://developers.google.com/maps/documentation/distance-matrix/start) qui malheureusement est en anglais et mon anglais n’est pas très à la hauteur.

Pourriez-vous m’aider à y voir clair ?
Merci d’avance pour votre aide.

Je viens de trouver un script sur internet, ça fonctionne pour calculer la distance entre deux ville,

Mais comment faire pour que ça calcul les distances entre mes divers point de départ et arrivée et qu’il m’affiche le total des kilomètres dans la colonne « AE » pour chaque ligne ?

Voici le fichier avec le script VBA: calcul-distance.xlsm (65,2 Ko)

Bonjour,

Une début de réponse, peut être.
Cordialement.
Distances_entre_2villes (et durée)- v1.xlsm (21,2 Ko)

Hello Zebulon,

Merci beaucoup pour ta réponse et ton fichier joint.
J’ai pris ton code et adapté à ma situation.

Par contre, j’ai une erreur d’excution 9 qui est dû à des champs sans valeur.
Est-il possible de lui dire que s’il y a rien dans ces champs, qu’il ne fasse rien et qu’il continu son chemin jusqu’au bout ?

Merci

Le cadre violet pour les champs qui n’ont pas reçu de valeurs et la cercle rouge indique que le programme n’a pas calculé la distance dû à l’erreur d’exécution 9.

Voici l’image :

Le script:

Option Explicit
Public Const DIST = « http://www.distance2villes.com/recherche?source= »

Sub CalculDistance()
Dim lg As Integer, i As Integer
Dim Url As String, Txt As String, d, temps

With Sheets(« Facturation »)
lg = .Cells(Rows.Count, 1).End(xlUp).Row
For i = 4 To lg
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), «  »)(0)
’ en nombre
.Range(« E » & i).NumberFormat = « #,##0 »
.Range(« E » & i) = Val(Replace(.Range(« E » & i), « , », «  »))
Next i
End With
End Sub

Re,

Je ne suis pas un spécialiste du VBA.
Essaies

Sub CalculDistance()
Dim lg As Integer, i As Integer
Dim Url As String, Txt As String, d, temps

With Sheets(« Facturation »)
lg = .Cells(Rows.Count, 1).End(xlUp).Row
For i = 4 To lg
     If range("B"&i).value = "" then
          Next i
     else
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), «  »)(0)
’ en nombre
.Range(« E » & i).NumberFormat = « #,##0 »
.Range(« E » & i) = Val(Replace(.Range(« E » & i), « , », «  »))
Next i
End if
End With
End Sub

A tester, sans aucune garantie.
Cordialement.

1 J'aime

Hello,

J’ai un message d’erreur : Next sans For

Voici en image:

Si j’enlève le premier, next i, il fait bien les calculs mais s’arrête avec le même code d’erreur que la dernière fois (Erreur d’exécution 9).

A+

Bon, je viens de comprendre pourquoi le programme s’arrête avec un code erreur d’exécution 9.

C’est à cause qu’il y a des 0 à la place de valeur texte, c’est ça mon soucis.
Il faut que je trouve comment faire pour que les champs ayant aucune information restent vides.

Donc, le code ci-dessous fonctionne parfaitement dès que les 0 ni sont pas:

Sub CalculDistance()
Dim lg As Integer, i As Integer
Dim Url As String, Txt As String, d, temps

With Sheets(« Facturation »)
lg = .Cells(Rows.Count, 1).End(xlUp).Row
For i = 4 To lg
If Range(« B » & i).Value <> «  » 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), «  »)(0)
'en nombre
.Range(« E » & i).NumberFormat = « #,##0 »
.Range(« E » & i) = Val(Replace(.Range(« E » & i), « , », «  »))
End If
Next i
End With
End Sub

Bonjour
Je me permet quelques petites suggestion
A essayer à la place de cette ligne :

If Range(« B » & i).Value <> « » Then

cette ligne :

If Range(« B » & i).Value <> 0 Then
ou
If Range(« B » & i).Value <> «0» Then
ou
If Range(« B » & i).Value Is Not Null Then

Peut être ne pas mettre le .Value

En désespoir de cause il est toujours possible de rajouter en amont de cette ligne juste avant par exemple cette ligne salvatrice :

On Error Resume Next

Qui a pour effet d’éviter le blocage et ainsi l’interruption de l’exécution

Seul inconvénient suite à cette instruction plus d’alerte sur d’éventuelle anomalie de code et de ne pas avoir le résultat escompté sans en connaitre la partie de traitement en cause

Si cela peut aider

Bonne suite

Hello FFO,

Merci de ta suggestion, j’ai essayé avec <> 0 et ça fonctionne bien aussi.

Mais je crois c’est un problème chez moi avec la rechercheV,
=SI(ESTVIDE($B$1);"";RECHERCHEV($B$1;‹ Google Maps ›!$A:$AF;12;0))

Mon fichier « FACTURATION » va chercher les adresses dans ma Base GOOGLE MAPS selon l’ID de la ligne. Certains champs sont vides car elle ne peuvent pas être connu lors de la création du nouveau transport à faire.

Donc automatiquement, il m’affiche les 0, ce qu’il ne fait plus si j’ajoute via le formulaire d’ajout « TRAJET SUPPLEMENTAIRE ». Mais dans les cases ou il y a aucune valeur.

Est-il possible d’indiquer dans le IF de départ ? :

If Range(« B » & i).Value <> " " OR <> 0 Then (cette version ne fonctionne pas.)

1 J'aime

C’est bon, je viens de trouver comment faire. :joy:

Voici la ligne du script:

If Range(« B » & i).Value <> «  » And Range(« B » & i).Value <> 0 Then

Merci à vous deux pour votre aide.

A bientôt

Bonjour et revis que tu ai trouvé la solution.

J’ai moi même un fichier excel pour noter les distances parcourues et aimerais bien adapter ton script à mon fichier mais n’ai aucune, mais alors aucune, connaissance en script.

Pourrais adapter ton script à mon fichier ?
Classeur1.xlsx (28,8 Ko)
Merci infiniment.

Hello,

Je ne suis pas non plus une personne professionnelle la dedans, mes résultats sont dû à divers recherche sur internet et aussi des divers conseils des membres de ce ce forum.

En gros, j’adapte à mes fichiers les exemples que je trouve ou qu’on me donne.

Pour ce qui est de ton fichier, il ne contient pas de colonne d’adresse de départ et d’arrivée.
Donc ce n’est pas possible pour moi d’essayer de te faire cette adaptation.

Bonsoir et merci de ton retour.

Peux tu y inclure les 2 colonnes… afin d’y adapter le script (c’est le point qui me pose problème)… le reste je me débrouille.

Cordialement

Rebonsoir ou Rebonjour,

Voici le fichier: Classeur1.xlsx (31,3 Ko)

Maintenant dodo.

Bon dimanche

Bonjour et merci pour ton aide.

j’ai le message d’erreur suivant lorsque je clique sur « calculer » : « Impossible d’exécuter la macro… »

J’ai pourtant autorisé l’utilisation des macros dans les options de sécurité, et enregistré le fichier sous format « prise en charge des macros »…

Je ne vois aucune macro dans la fenêtre développeur > Macros.

Cordialement

Bonjour,

Effectivement, les modifications non pas été sauvegardées, car à la base votre fichier était pas enregistré dans un format qui prend en charge les marcros.

Prenez l’habitude, d’enregistrer vos fichiers en format "Classeur Excel (prenant en charge les macros)(*.xlsm).

Voici le fichier :CalculDistance.xlsm (40,0 Ko)

Bonne journée

Bonjour et merci de votre aide.

Quel est le mot de passe pour ôter la protection de la feuille distance ?

Cordialement

Bonjour,

Désolé, j’avais laisse mon script par défaut.

Voici le fichier sans protection:CalculDistance.xlsm (39,8 Ko)

Bonne soirée

Merci et bonne soirée

J’ai réussi à modifier le script pour combiner les 2 feuille en une seule :slight_smile: .
Seule incertitude sur le « d » remplacé par un « e » dans le code suivant (je ne sait pas si j’ai bien fait ? :
Dim Url As String, Txt As String, d, temps

Ce qui me donne le code suivant après modification :
'====================
'Calcul des distances
'www.peachbird.com
'====================
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, e, temps
With Sheets(« 2020 (RIVIERE Florence) »)
lg = .Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lg
If Range(« C » & i).Value <> «  » And Range(« C » & i).Value <> 0 Then
Url = DIST & .Range(« C » & i).Value & « &destination= » & .Range(« D » & 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), «  »)(0)
'en nombre
.Range(« E » & i).NumberFormat = « ##,## »
.Range(« E » & i) = Val(Replace(.Range(« E » & i), « , », «  »))
End If
Next i
End With
MsgBox « Le calcul des KMs est terminé ! »
End Sub

Ce script fonctionne bien…

Cela dit il mon classeur excel comporte plusieurs feuille et je ne sais pas comment faire en sorte que le script calcul le kilométrage par feuille excel et non sur l’ensemble des feuille du classeur (dois-je copier le script pour en créer un second et l’adapter à la seconde feuille ? Mais comment copier le script ?) Désolé de t’embêter mais comme tu le sais je ne connais rien en script.

Voici mon fichier modifier dans lequel j’ai ajouté une feuille : Copie de CalculDistance-1.xlsm (57,1 Ko)

Merci infiniment