Variable de texte dans une function

Version imprimable

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:

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:

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 !

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

Code:

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:

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:

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:

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:

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

28/06/2018, 10h42
Electro02

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

Citation:
Envoyé par Electro02
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:

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:

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.

28/06/2018, 13h28
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.