Discussion :

[Electro02]

Bonjour.

Voici mon souci.

Parmi d'autres, j'utilise ce bout de code, dans une fonction, pour la création d'un distancier Excel usant des API de Google Maps

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
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
Function AversB(A As String, B As String) As deAaB

Dim Depart As String, Arrivee As String, Site As String
Dim Json As Object, Elem As Object, Elem1 As Object
Dim ok As Boolean

    With Sheets("Distancier_via_GoogleMaps")
        Depart = SupprCaracSpe(A)
        Arrivee = SupprCaracSpe(B)
        
        On Error Resume Next
        Site = "https://maps.googleapis.com/maps/api/distancematrix/json?origins=" & Depart & "&destinations=" & Arrivee & "&mode=driving&language=fr-FR&key=XxXXx_XXXxX_xxXXx_XxXxX"
        Set Json = oRecordSet(Site)

        For Each Elem In Json.rows
            For Each Elem1 In Elem.elements
                ok = Not (Elem1.status = "ZERO_RESULTS")
                AversB.dist = Elem1.distance.Value / 1000
                AversB.duree = Elem1.duration.Value / 24 / 60 / 60
            Next Elem1
        Next Elem

        ScriptControl.AddCode "Object.prototype.item=function( i ) { return this[i] } ; "
        AversB.ptA = Json.origin_addresses.item(0)
        AversB.ptB = Json.destination_addresses.item(0)

        If Not ok Then
            AversB.dist = 0
            AversB.duree = 0
        End If

        Set Json = Nothing
    
    End With
    
End Function

Ce code, associé à d'autres FUNCTION et à une SUB, fonctionne à merveille... et même encore il y a quelques jours si on supprimait la clé API personnelle (key=)

Mais depuis quelques jours, les API Google Maps sont (presque) plus gratuites, et mon outil doit être utilisé par plusieurs personnes, dans des lieux différents.
Je n'ai pas envie de partager ma clé API perso avec tous et payer pour les autres lol... et l'utilisation en mode "anonyme" ne fonctionne plus donc.

Dans mon fichier Excel, j'ai donc ajouter une cellule dans une autre feuille, où il est demandé à l'utilisateur de saisir sa clé API.

Sauf que je n'arrive pas à l'intégrer dans mon code Function que je vous ai présenté... J'avais pensé à l'ajout d'une variable :

Code :

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

1
2
3
4
5
6
7
8
9
10
(...)
Dim API_Perso As String
API_Perso = Range("A1").Value   'ou Cells(1, 1).Value

(...)

Site = "https://maps.googleapis.com/maps/api/distancematrix/json?origins=" & Depart & "&destinations=" & Arrivee & "&mode=driving&language=fr-FR&key=" & API_Perso

(...)

Mais cela ne fonctionne pas... Je débute dans les macros, mais je crois bien que je ne peux pas déclarer la valeur d'une cellule dans une variable, et l'utiliser comme dans un Sub, non ?

J'avais pensé à une macro qui copie-coller le contenu "texte" d'une cellule directement au sein de la macro suivante (genre j'insère ma ligne 'site = "https://......' avec la clé en cellule A1 et une première macro me copie le texte en ligne 12 de la macro suivante, qui contient le code 'FUNCION', dans le Module 1 VBA... Mais je ne sais pas si c'est possible.

Y a t-il une solution concrète ? Laquelle ? Comment ?

Merci mille fois !

[Electro02]

Si ça peut aider : le code complet dans mon Module 1 :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
 
Option Explicit
 
Public ScriptControl As Object
 
Public Type deAaB
    ptA As String
    ptB As String
    dist As Single
    duree As Single
End Type

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
23
24
25
 
Sub Serie()
Dim Tdata As Variant, lg As Long, i As Long
Dim Trajet As deAaB
 
Range("J1").Value = "Veuillez patienter svp..."
 
    With Sheets("Distancier_via_GoogleMaps")
        lg = .Cells(rows.Count, "A").End(xlUp).row
        Tdata = .Range(.Cells(2, "A"), .Cells(lg, "F")).Value
 
        For i = 1 To lg - 1
            Trajet = AversB(SupprCaracSpe(Tdata(i, 1)), SupprCaracSpe(Tdata(i, 2)))
            Tdata(i, 5) = Trajet.ptA
            Tdata(i, 6) = Trajet.ptB
            Tdata(i, 3) = 1 * Format(Trajet.dist, "# ###.00")
            Tdata(i, 4) = Trajet.duree
        Next i
 
        .Range("A2").Resize(UBound(Tdata, 1), UBound(Tdata, 2)) = Tdata
    End With
 
    Range("J1").Value = "Cliquez sur ETAPE 2 svp"
 
End Sub

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
23
24
25
 
Function SupprCaracSpe(Sv As Variant) As String
 
Dim S As String
 
    S = CStr(Sv)
    S = Replace(S, "'", " ")
    S = Replace(S, "L ", "")
    S = Replace(S, "â", "a")
    S = Replace(S, "à", "a")
    S = Replace(S, "ä", "a")
    S = Replace(S, "ê", "e")
    S = Replace(S, "é", "e")
    S = Replace(S, "è", "e")
    S = Replace(S, "ë", "e")
    S = Replace(S, "ï", "i")
    S = Replace(S, "ô", "o")
    S = Replace(S, "ö", "o")
    S = Replace(S, "û", "u")
    S = Replace(S, "ù", "u")
    S = Replace(S, "ü", "u")
 
    SupprCaracSpe = S
 
End Function

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
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
 
Function AversB(A As String, B As String) As deAaB
 
Dim Depart As String, Arrivee As String, Site As String
Dim Json As Object, Elem As Object, Elem1 As Object
Dim ok As Boolean
 
    With Sheets("Distancier_via_GoogleMaps")
        Depart = SupprCaracSpe(A)
        Arrivee = SupprCaracSpe(B)
 
        On Error Resume Next
        Site = "https://maps.googleapis.com/maps/api/distancematrix/json?origins=" & Depart & "&destinations=" & Arrivee & "&mode=driving&language=fr-FR&key=XXXXX_XXXXX_XXXXX_XXXXX"
        Set Json = oRecordSet(Site)
 
        For Each Elem In Json.rows
            For Each Elem1 In Elem.elements
                ok = Not (Elem1.status = "ZERO_RESULTS")
                AversB.dist = Elem1.distance.Value / 1000
                AversB.duree = Elem1.duration.Value / 24 / 60 / 60
            Next Elem1
        Next Elem
 
        ScriptControl.AddCode "Object.prototype.item=function( i ) { return this[i] } ; "
        AversB.ptA = Json.origin_addresses.item(0)
        AversB.ptB = Json.destination_addresses.item(0)
 
        If Not ok Then
            AversB.dist = 0
            AversB.duree = 0
        End If
 
        Set Json = Nothing
 
    End With
 
End Function

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
23
24
25
 
Function oRecordSet(txt As String, Optional www As Boolean = True) As Object
 
Dim Html As Object, Obj As Object
Dim S As String
 
    Set ScriptControl = CreateObject("MSScriptControl.ScriptControl")
    ScriptControl.Language = "JScript"
 
    If www Then
        Set Html = CreateObject("MSXML2.XMLHTTP")
        With Html
        .Open "GET", txt, False
        .send
        S = .responsetext
        End With
    Else
        S = txt
    End If
 
    Set Obj = ScriptControl.Eval("(" & S & ")")
    Set oRecordSet = Obj
    Set Obj = Nothing
 
End Function

[Electro02]

Je me débrouillerai donc sans votre aide :-(

[Menhir]

Dans mon fichier Excel, j'ai donc ajouter une cellule dans une autre feuille, où il est demandé à l'utilisateur de saisir sa clé API.

Sauf que je n'arrive pas à l'intégrer dans mon code Function que je vous ai présenté... J'avais pensé à l'ajout d'une variable :

Code :

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

1
2
3
4
5
6
7
8
9
10
(...)
Dim API_Perso As String
API_Perso = Range("A1").Value   'ou Cells(1, 1).Value

(...)

Site = "https://maps.googleapis.com/maps/api/distancematrix/json?origins=" & Depart & "&destinations=" & Arrivee & "&mode=driving&language=fr-FR&key=" & API_Perso

(...)

Mais cela ne fonctionne pas... Je débute dans les macros, mais je crois bien que je ne peux pas déclarer la valeur d'une cellule dans une variable, et l'utiliser comme dans un Sub, non ?

A priori, ton code est correct même si, perso, j'aurais plutôt écrit.

Code :

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

API_Perso = Range("A1").Text

Fais un Debug.Print Site juste après ton Site = ... et regarde ce que ça donne dans le fenêtre d'exécution pour vérifier si l'adresse construite est correcte.

[Electro02]

Non le code ne fonctionnait pas en ajoutant une variable de clé API.
Mais le souci venait des fonctions et de la gestion Json.
Le souci a été résolu.

Merci en tout cas.