Microsoft 365 Calcul de distance et de temps de trajet entre deux villes

[marloniBrando]

Bonjour à tous,

Dans le cadre de mon travail et plus particulièrement afin d'optimiser le temps de trajet en voiture de mes employés, j'aimerais créer un fichier EXCEL permettant de calculer automatiquement la distance en KM et la durée de trajet en voiture et en train entre deux villes. J'ai longuement cherché sur les forums mais je n'ai pas trouvé de solution, les api ont changé depuis ce qui me complique la tâche. De plus je ne suis pas un crack en informatique et je suis incapable de programmer seul ce type de modèle. Je suis actuellement sur Excel Version 16.34 Office 365.

Je vous joint un fichier type que je souhaiterais exploiter. Pour un sujet de confidentialité j'ai mis des adresses fictives, il y en a 700 en réalité. L'idée serait donc de pouvoir recalculer brièvement le temps de trajet à chaque fois que l'on change la ville d'arrivée.

PS: SI jamais sur mac c'est trop compliqué, je possède un ordinateur avec une tour et un EXCEL 2007 que je pourrais utiliser en dernier recours.

Merci d'avance pour vos réponses, cela me serait d'une immense utilité!

Cordialement,

MARC

 

[laurent3372]

Bonjour,

J'ai utilisé l'API de Bing et j'ai codé des fonctions personnalisées en VBA.

Function GetDistance(adr1 As String, adr2 As String) As Variant
    Dim url As String
    Dim text As String
    Dim xhr As New MSXML2.XMLHTTP60
    Dim oRe As New RegExp
    Dim oMc As MatchCollection
    Dim repText As String
    
    oRe.Pattern = """travelDistance"":(\d+.\d+),"
    'On Error Resume Next
    Application.StatusBar = "Recherche distance en cours …"
    url = "http://dev.virtualearth.net/REST/v1/Routes/driving" & _
        "?key=AqfaTCi9xqn5pr_NHoTrpRy8g9x9VnHJqqQcCUTr8xG7kofvzNacQMEAg5GmvLII" & _
        "&Waypoint.0=" & URLCode(adr1) & _
        "&Waypoint.1=" & URLCode(adr2) & _
        "&maxSolutions=1" & _
        "&distanceUnit=km" & _
        "&routeAttributes=excludeItinerary"
    xhr.Open "GET", url, False
    xhr.send
    text = xhr.responseText
    Set oMc = oRe.Execute(text)
    If oMc.Count > 0 Then
        repText = oMc(0).SubMatches(0)
        GetDistance = CDbl(Replace(repText, ".", ","))
    Else
        GetDistance = "Non trouvé"
    End If
    Application.StatusBar = "Terminé."
End Function

Et ensuite, sur la feuille:

=GetDistance($C4;$E4)
=GetDurée($C3;$E3;"driving")

(Même principe pour les durées où mode="driving" (en voiture) ou "transit" (transports en commun)

Cordialement,
--
LR

 

[marloniBrando]

Bonjour et merci beaucoup pour votre aide, tout cela m'a l'air très intéressant. Cependant sur MacBook le calcul ne se fait pas, il y a-t-il un petit détail à changer?

 

[laurent3372]

Quels sont les symptômes ? Qu'y a-t-il d'affiché dans les cellules contenant les formules ?

 

[marloniBrando]

Quels sont les symptômes ? Qu'y a-t-il d'affiché dans les cellules contenant les formules ?

Dans les cellules contenant les formules, il y écrit #NOM? et #VALEUR?, et quand je tape sur entrée on voit 00,00 et 00:00:00.

Merci d'avance pour ton aide, c'est vraiment la galère et ça serait exceptionnel que ca marche.

 

[laurent3372]

S'il y a marqué #NOM, c'est que la fonction personnalisée n'a pas été trouvée. Es-tu bien sûr d'avoir ouvert mon fichier .xlsm et non pas un xlsx dans lequel tu aurais codé mes formules ? Sinon, il faudra essayer sur un PC. Je ne connais pas bien le Mac.

 

[zonoar]

Bonjour,

J'ai le même besoin.
J'ai essayé avec l'API google que je n'arrive pas à activer...
Quand j'ouvre votre fichier j'ai en réponse Non trouvé

Merci d'avance pour vos lumières...

Arnaud

 

[GALOUGALOU]

bonjour marlonibrando bonjour le forum
sur le site de tatiak

Tatiak

Excel, Vba, Vbs

tatiak.canalblog.com

vous pouvez trouver ce genre de classeur
cordialement
galougalou

 

[Nthierry74]

Bonjour,

J'ai utilisé l'API de Bing et j'ai codé des fonctions personnalisées en VBA.

Function GetDistance(adr1 As String, adr2 As String) As Variant
    Dim url As String
    Dim text As String
    Dim xhr As New MSXML2.XMLHTTP60
    Dim oRe As New RegExp
    Dim oMc As MatchCollection
    Dim repText As String
   
    oRe.Pattern = """travelDistance"":(\d+.\d+),"
    'On Error Resume Next
    Application.StatusBar = "Recherche distance en cours …"
    url = "http://dev.virtualearth.net/REST/v1/Routes/driving" & _
        "?key=AqfaTCi9xqn5pr_NHoTrpRy8g9x9VnHJqqQcCUTr8xG7kofvzNacQMEAg5GmvLII" & _
        "&Waypoint.0=" & URLCode(adr1) & _
        "&Waypoint.1=" & URLCode(adr2) & _
        "&maxSolutions=1" & _
        "&distanceUnit=km" & _
        "&routeAttributes=excludeItinerary"
    xhr.Open "GET", url, False
    xhr.send
    text = xhr.responseText
    Set oMc = oRe.Execute(text)
    If oMc.Count > 0 Then
        repText = oMc(0).SubMatches(0)
        GetDistance = CDbl(Replace(repText, ".", ","))
    Else
        GetDistance = "Non trouvé"
    End If
    Application.StatusBar = "Terminé."
End Function

Et ensuite, sur la feuille:

=GetDistance($C4;$E4)
=GetDurée($C3;$E3;"driving")

(Même principe pour les durées où mode="driving" (en voiture) ou "transit" (transports en commun)

Cordialement,
--
LR

Bonjour

Merci pour ce fichier très intéressant
cependant depuis cette semaine il ne fonctionne plus, toutes les réponse sont "Non trouvé"
je ne suis pas très fort en informatique, mais j'ai l'impression que l'API ne répond plus

peut on m'aider?