Discussion :

[grimgrim]

Bonsoir,

J'ai réalisé une connexion avec google maps pour lire la distance et la durée avec le code suivant :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

ConnectStr = "URL;https://maps.googleapis.com/maps/api/distancematrix/json?origins=" & PointDépart & "&destinations=" & PointArrivée & "&sensor=false"

Les informations s'affichent bien sur la feuille demandée dans la première colonne comme indiquée ci-dessous.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
{
   "destination_addresses" : [ "Saint-Trivier-sur-Moignans, France" ],
   "origin_addresses" : [ "Allonzier-la-Caille, France" ],
   "rows" : [
      {
         "elements" : [
            {
               "distance" : {
                  "text" : "143 km",
                  "value" : 143398
               },
               "duration" : {
                  "text" : "1 hour 40 mins",
                  "value" : 6009
               },
               "status" : "OK"
            }
         ]
      }
   ],
   "status" : "OK"
}

Pour récupérer la distance et la durée, j'ai écris cela :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
 .Refresh BackgroundQuery:=False
        NEssai = NEssai + 1
    Set Result = Sheets("Calcul").Range("A1:B100").Find("duration")
        If Not Result Is Nothing Then
        Adresse = Result.Address
        Set Plage = Sheets("Calcul").Range(Adresse & ":A100")
        NEssai = 6 'On sort de la boucle quand on a un résultat
        End If

Le problème est que le programme ne détecte pas "duration" et de même quand je fais sur la feuille directement un CTRL + F
Avez vous une idée ?

Cordialement,

[mercatog]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

.....Find("duration", LookIn:=xlValues, LookAt:=xlPart)

[grimgrim]

Merci je vais tester

Par contre, peux tu expliquer à quoi correspond ces deux attributs, je n'ai pas trouver

Cordialement,

[patricktoulon]

bonjour
je te propose un autre regard en utilisant un object xmlhttp en VBA

dans la fonction tu a 2 variables qui sont des string et qui contienne les valeur que tu cherche a toi d'adpater

il te suffit d'injecter le depart et l'arrivée dans l'appel de la fonction dans la sub test

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
'exemple https://maps.googleapis.com/maps/api/distancematrix/json?origins=toulon&destinations=paris&sensor=false"
Sub test()
    donnéegooglemaps "toulon", "paris"
End Sub
Function donnéegooglemaps(depart, arrivée)
    Dim DemandeFichier As Object, distance As String, durrée As String,url as string 
    url = "https://maps.googleapis.com/maps/api/distancematrix/json?origins=" & depart & "&destinations=" & arrivée & "&sensor=false"
    Set DemandeFichier = CreateObject("Microsoft.XMLHTTP")  'instancie l'object
    DemandeFichier.Open "POST", url, False
    DemandeFichier.send
    'MsgBox DemandeFichier.responsetext'ce message t'affiche tout le texte en entier
 
    distance = Split(Split(DemandeFichier.responsetext, "text"" : ")(1), ",")(0)
    durrée = Split(Split(DemandeFichier.responsetext, "text"" : ")(2), ",")(0)
 
 
 MsgBox "disitance a parcourir = " & distance & vbCrLf & "durée du voyage = " & durrée
End Function

a mediter

[grimgrim]

Merci, cela fonctionne

la solution de PatrickToulon fonctionne, l'autre solution émet une erreur

Par contre, Patrick, j'obtiens une erreur quand il ne trouve pas d'information NOT_FOUND

et cela bloque

Cordialement,

[patricktoulon]

Bonjour
c'est un code de base que je t'ai donné

il va te falloir maintenant intégrer la gestion d'erreur

pour cela il faut que tu VERIFIE la présence de "NOT-FOUND" dans le texte retourné du json

la fonction INSTR fera très bien l'affaire

simplement comme ceci:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
 
'exemple https://maps.googleapis.com/maps/api/distancematrix/json?origins=toulon&destinations=paris&sensor=false"
Sub test()
    donnéegooglemaps "trucmuche", "paris"
End Sub
Function donnéegooglemaps(depart, arrivée)
    Dim DemandeFichier As Object, distance As String, durrée As String, url As String, message As String
    url = "https://maps.googleapis.com/maps/api/distancematrix/json?origins=" & depart & "&destinations=" & arrivée & "&sensor=false"
    Set DemandeFichier = CreateObject("Microsoft.XMLHTTP")  'instancie l'object
    DemandeFichier.Open "POST", url, False
    DemandeFichier.send
   ' MsgBox DemandeFichier.responsetext    'ce message t'affiche tout le texte en entier
 
    If InStr(DemandeFichier.responsetext, "NOT_FOUND") > 0 Then
        message = "pas de donnée pour ce parcour " & vbCrLf & " veuillez verifier le depart ou destination"
    Else
        distance = Split(Split(DemandeFichier.responsetext, "text"" : ")(1), ",")(0)
        durrée = Split(Split(DemandeFichier.responsetext, "text"" : ")(2), ",")(0)
        message = "disitance a parcourir = " & distance & vbCrLf & "durée du voyage = " & durrée
    End If
    MsgBox message
End Function

rien de plus facile
Au plaisir