Bonjour à tous,

J'utilise un code qui n'est pas de moi et que j'ai trouvé sur un autre forum. Ce code permet, lorsqu'on lui rentre une adresse de départ et une adresse d'arrivée, de calculer la distance routière entre ces deux points. Le problème c'est que moi je fais faire à ce programme des boucles via un autre classeur excel. Je suis assez vite confronté au problème du "Over Query Limit".

Alors il va sans dire que je ne saurais pas expliquer les lignes ci-dessous, mais si j'ai bien compris, excel envoie une requête à google avec les informations saisies, et goolgle lui renvoie les distances etc... Sauf que là, il envoie Over Query Limit pour nous signaler qu'on le surcharge trop.

J'avais donc quelques questions à ce sujet car ça me pose problème. Je voudrais savoir s'il y avait un moyen (ralentir le nombre de requètes par minutes etc...) de contourner ce message pour que le progamme fonctionne en permanence. Par la même occasion, savez vous quand est-ce que les compteurs sont réinitialisés ?

Merci de votre aide précieuse, je vous quote le code correspondant :

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
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
Sub ItinéraireGoogle()
  Dim DepAdr As String, DepVille As String
  Dim FinAdr As String, FinVille As String
  Dim DLigData As Long, SLigData As String
  Dim DLigIti As Long, IndFlg As Integer
  Dim Lien As String, RqtWeb As String, IncRqt As Long
  ' Récupérer les valeurs des variables
  With Sheets("Itinéraire")
    DepAdr = .Range("DepAdr").Value
    DepVille = .Range("DepVille").Value
    FinAdr = .Range("FinAdr").Value
    FinVille = .Range("FinVille").Value
    ' Effacer l'itinéraire précédent si existant
    .Range("TotalKm").ClearContents
    .Range("TotalDurée").ClearContents
    .Range("LienMap").Hyperlinks.Delete
    DLigIti = .Range("D" & Rows.Count).End(xlUp).Row
    If DLigIti > 1 Then
      .Range("D2:H" & DLigIti + 1).ClearContents
    End If
    ' Vérifier que des adresses ont bien été saisies
    If DepVille = "" Then
      .Range("DepVille").Select
      MsgBox "Vous devez impérativement mettre le code postal + la ville de départ", vbCritical, "ATTENTION ..."
      Exit Sub
    End If
    If FinVille = "" Then
      .Range("FinVille").Select
      MsgBox "Vous devez impérativement mettre le code postal + la ville d'arrivée", vbCritical, "ATTENTION ..."
      Exit Sub
    End If
    ' Inscrie le lien Hypertext
    Lien = "http://maps.google.fr/maps?f=d&saddr=" & DepAdr & "," & DepVille & "&daddr=" & FinAdr & "," & FinVille
    ActiveSheet.Hyperlinks.Add Anchor:=.Range("LienMap"), Address:=Lien, TextToDisplay:="Maps"
  End With
  ' Création de la requète web
  RqtWeb = "URL;http://maps.google.fr/maps/api/directions/json?origin=" & DepAdr & "," & DepVille _
         & "&destination=" & FinAdr & "," & FinVille & "&sensor=false"
  ' Définir la feuille de data source
  Set ShtS = Sheets("DataGoogle")
  ' Récupérer l'incrément du nombre de requète
  IncRqt = Sheets("Itinéraire").Range("NbRqt").Value
  ' Sur la feuille des data Google
  With ShtS
    On Error Resume Next
    If IncRqt = 0 Then
      .Names("Requete_GoogleMaps").Delete
    Else
      .Names("Requete_GoogleMaps_" & IncRqt).Delete
    End If
    .Cells.EntireRow.Delete
    On Error GoTo 0
    ' Créer la requête
    With .QueryTables.Add(Connection:=RqtWeb, Destination:=.Range("A1"))
      .Name = "Requete_GoogleMaps"
      .BackgroundQuery = True
      .WebSelectionType = xlEntirePage
      .WebFormatting = xlWebFormattingNone
      .Refresh BackgroundQuery:=False
    End With
  End With
  ' Incrémenter le nombre de requète effectuer pour la suppression ensuite
  IncRqt = Sheets("Itinéraire").Range("NbRqt").Value
  Sheets("Itinéraire").Range("NbRqt").Value = IncRqt + 1
  ' Vérifier que l'utilisateur veux le détail
  If Sheets("Itinéraire").CheckBox1.Value = False Then
    Call InfoGlobal
    Exit Sub
  End If
  ' Extraire les données du résultat de la requête
  DLigData = ShtS.Range("A" & Rows.Count).End(xlUp).Row
  IndFlg = 0
  For LigData = 1 To DLigData
    SLigData = ShtS.Range("A" & LigData)
    ' Itinéraire non trouvé
    If InStr(1, SLigData, "NOT_FOUND", vbTextCompare) > 0 Then
      With Sheets("Itinéraire")
        DLigIti = .Range("D" & Rows.Count).End(xlUp).Row + 1
        .Range("D" & DLigIti).Value = "Itinéraire introuvable, veuillez vérifier vos adresses !"
      End With
    End If
    ' Durée en minutes
    If InStr(1, SLigData, "duration", vbTextCompare) > 0 Then
      Durée = ConvDurée(ShtS.Range("A" & LigData + 2))
      IndFlg = IndFlg + 1 ' Flag de donnée récupée
      LigData = LigData + 2
    End If
    ' Instruction
    If InStr(1, SLigData, "html_instructions", vbTextCompare) > 0 Then
      Instruction = ConvInst(SLigData)
      IndFlg = IndFlg + 1 ' Flag de donnée récupée
    End If
    ' Distance
    If InStr(1, SLigData, "distance", vbTextCompare) > 0 Then
      Distance = Split(ConvDistance(ShtS.Range("A" & LigData + 2)), " ")
      IndFlg = IndFlg + 1 ' Flag de donnée récupée
    End If
    ' Si toutes les données nécessaires ont été récupérées
    If IndFlg = 3 Then
      ' Sinon inscrire les valeurs sur la ligne
      With Sheets("Itinéraire")
        DLigIti = .Range("G" & Rows.Count).End(xlUp).Row + 1
        .Range("G" & DLigIti).Value = Durée
        .Range("D" & DLigIti).Value = Instruction
        .Range("E" & DLigIti).Value = CSng(Distance(0))
        .Range("F" & DLigIti).Value = Distance(1)
      End With
      IndFlg = 0  ' Réinitialiser l'indice flag
    End If
    ' si il s'agit de la fin du processus
    If InStr(1, ShtS.Range("A" & LigData + 12), "start_address", vbTextCompare) > 0 Then
      With Sheets("Itinéraire")
        .Range("TotalKm").Value = Distance(0)
        .Range("TotalDurée").Value = Durée
      End With
    End If
  Next LigData
  Set ShtS = Nothing
End Sub