Discussion :

[phoenix974]

Bonjour à tous,

J'aimerais pouvoir effectuer X requêtes en fonction des choix fait sur une liste de choix multiples d'un formulaire et sauvegarder les différentes réponses, puis retourner les réponses dans un autre formulaire.

J'ai préparé les formulaires mais je ne sais pas comment continuer. Voici le code utilisé :

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
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
Sub test()
    dep = IIf([C2].Value = "", [C3].Value, [C2].Value)
    fin = IIf([C4].Value = "", [C5].Value, [C4].Value)
    If dep = "" Or fin = "" Then MsgBox "remplir correctement!!! le depart et la destination": pageblanche: Exit Sub
    pageblanche
    Dim tablo(500, 10), tablobase, donnée1 As String
    donnée1 = itineraire(dep, fin)
    '***********************************************tableau de gauche*****************************
    With Sheets(2)
        .[B16] = Split(Split(donnée1, "text"" : """)(1), Chr(34))(0)
        .[B18] = Split(Split(donnée1, "value"" :")(2), "  ")(0)
        .[B19] = Replace(Replace(Split(Split(donnée1, "text"" : """)(2), Chr(34))(0), "heures", ":"), "minutes", ":") & "00"
        .[B22] = dep
        .[B23] = fin
        .[C9] = Split(Split(donnée1, "lat"" :")(2), ",")(0)
        .[C10] = Split(Split(donnée1, "lng"" :")(2), "  ")(0)
        .[C12] = Split(Split(donnée1, "lat"" :")(1), ",")(0)
        .[C13] = Val(Split(Split(donnée1, "lng"" :")(1), "  ")(0))
 
 
    End With
    '***********************************************tableau de droite*****************************
    donnée2 = Split(donnée1, "start_address")(1)
    Debug.Print texte
    tablobase = Split(donnée2, "points")
    For i = 0 To UBound(tablobase) - 2
        tablo(i, 0) = Split(Split(tablobase(i), "html_instructions"" : """)(1), Chr(34))(0)
        tablo(i, 1) = Split(Split(tablobase(i), "text"" : """)(1), Chr(34))(0)
        tablo(i, 2) = Split(Split(tablobase(i), "text"" : """)(2), Chr(34))(0)
        tablo(i, 3) = Split(Split(tablobase(i), "lat"" :")(1), ",")(0)
        tablo(i, 4) = Val(Split(Split(tablobase(i), "lng"" :")(1), "  ")(0))
        tablo(i, 5) = Split(Split(tablobase(i), "lat"" :")(2), ",")(0)
        tablo(i, 6) = Val(Split(Split(tablobase(i), "lng"" :")(2), "  ")(0))
        tablo(i, 7) = "https://maps.google.fr/maps?q=" & tablo(i, 3) & "," & Replace(tablo(i, 4), ",", ".")
 
 
    Next
    Sheets(2).Cells(2, 4).Resize(UBound(tablo), 10) = tablo
End Sub
Function itineraire(dep, fin)
    Dim REQ As Object, url As String
    Set REQ = CreateObject("microsoft.xmlhttp")
    'ex:http://maps.google.fr/maps/api/directions/json?origin=toulon 83000,&destination=paris 75000
    url = "http://maps.google.fr/maps/api/directions/json?origin=" & Replace(dep, " ", "") & ",&destination=" & Replace(fin, " ", "")
    With REQ
        .Open "POST", url, False
        .SetRequestHeader "Accept", "text/html, application/xhtml+xml, */*"
        .SetRequestHeader "Accept-Language", "fr-FR"
        .SetRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; WOW64; Trident/7.0; rv:11.0) like Gecko"
        .SetRequestHeader "Accept-Encoding", "gzip, deflate"
        .SetRequestHeader "Host", "maps.google.fr"
        .SetRequestHeader "Connection", "Keep - Alive"
        .SetRequestHeader "Cache-Control", "no-cache"
        .send
        itineraire = Replace(.responsetext, vbCrLf, "")
        itineraire = Replace(itineraire, "/", "")
        itineraire = Replace(itineraire, "\", "")
        itineraire = Replace(itineraire, "u003cbu003e", " ")
        itineraire = Replace(itineraire, "points", vbCrLf & "points")
        itineraire = Replace(itineraire, "u003cdiv style=", "")
    End With
End Function

[Zekraoui_Jakani]

Peux-tu illustrer ta demande avec des exemples concrets ? Le fait de mettre un code ne suffit pas !
Requête = ?
Résultat attendu = ?