Forum Excel

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 :

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