Arrêt de programme Google Map

**grimgrim** · 03/11/2014, 23h03

Bonsoir,

J'ai un code qui permet de récupérer la durée et la distance entre deux viles à partir de Google Map.
Or, il récupère une vingtaine de durées et distance et ensuite il se connecte bien au web mais ne récupère plus rien (vide)
voici le code et avez vous une idée ?

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
Sub Calcul(PointArrivée As String, PointDépart As String)
NEssai = 0
Sheets.Add after:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = "Calcul"
Durée = ""
Distance = ""
DuréeOK = False
DistanceOK = False
 
    ConnectStr = "URL;http://maps.google.fr/maps?f=d&saddr=" & PointDépart & "&daddr=" & PointArrivée
    With Sheets("Calcul").QueryTables.Add(Connection:=ConnectStr, Destination:=Sheets("Calcul").Range("A1"))
        .Name = "itinéraire"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = False
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingAll
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
'        .BackgroundQuery = True
'        .WebSelectionType = xlEntirePage
'        .WebFormatting = xlWebFormattingNone
        Do
        On Error Resume Next
        .Refresh BackgroundQuery:=False
        NEssai = NEssai + 1
    Set Result = Sheets("Calcul").Range("A1:B100").Find("Itinéraires possibles")
        If Not Result Is Nothing Then
        Adresse = Result.Address
        Set Plage = Sheets("Calcul").Range(Adresse & ":A100")
        NEssai = 6 'On sort de la boucle quand on a un résultat
        End If
        Loop While NEssai < 5
    End With
 
        If NEssai = 6 Then
            For Each Result In Plage
                If InStr(Result, "seconde") = 0 Then
                      If (InStr(Result, "heure") Or InStr(Result, "min") Or InStr(Result, "mn")) And DuréeOK = False Then
                      Durée = Result
                      Durée = Mid(Durée, InStr(Durée, "m,") + 3)
                      DuréeOK = True
                      End If
                      If InStr(Result, "m,") And DistanceOK = False Then 'm, parce que distance courte
                        If InStr(Result, "km") > 0 Then
                        Distance = Result
                        Distance = Left(Distance, InStr(Distance, "km,") - 1)
                        ElseIf InStr(Result, "m,") > 0 Then
                        Distance = "0"
                        End If
                      DistanceOK = True
                      End If
                  Else
                      Durée = "0 min"
                      Distance = "0"
                      DuréeOK = True
                      DistanceOK = True
                  End If
 
                      If DistanceOK And DuréeOK Then
                      Exit For
                      End If
            Next Result
        End If
Application.DisplayAlerts = False
Sheets(Sheets.Count).Delete
Application.DisplayAlerts = True
End Sub

merci d'avance

**lucasgaetan** · 05/11/2014, 11h25

bonjour,

Cher moi, ça fonctionne très bien, j'ai juste supprimer les 3 dernière lignes pour visualiser un resultat:

Code :

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

1
2
3
Application.DisplayAlerts = False
Sheets(Sheets.Count).Delete
Application.DisplayAlerts = True

je n'ai pas compris ou tu stockais les infos.
que fait-tu de tes variable distance et durée ?

Regard du coté des déclarations de variables (t'en as aucune) --> cela libère de la mémoire quand tu sorts de ta fonction et permet de mieux visualiser.

Slt,

**grimgrim** · 05/11/2014, 13h55

Oui, moi aussi cela foncitonne mais cela ne foncitonne plus au bout d'une vingtaine de connexion à google

voici le code qui appelle le précédent :

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
120
Option Explicit
Dim Chemin As String
Dim NomClasseur As String
Dim NomFeuille As String
Dim NColonne As Integer
Dim i As Long
Dim j As Long
Dim n As Long
Dim z As Integer
Dim NLigne As Long
Dim Départ As String
Dim Arrivée As String
Dim Result As Object
Dim Adresse As String
Dim Plage As Object
Public Durée As String
Public Distance As String
Dim NOK As String
Dim DuréeOK As Boolean
Dim DistanceOK As Boolean
Dim ConnectStr As String
Dim Département As Object
Dim DuréeMn  As Integer
Dim NHeures As Integer
Dim NMinutes As Integer
Dim LDébutMinutes As Integer
Dim ColonneDuréeMin As Integer
Dim NbMagNiveau2 As Integer
Dim Nom As String
Dim Chargement As Boolean
Dim CodeMagasin As String
Dim RangMagasin As String
Dim NbMag As Integer
Dim PrésenceCalcul As Boolean
Dim NEssai As Integer
Dim Mag() As String
Dim NomMag() As String
 
Sub BDuréeDistance()
Windows("Maillage_CBN_Spare_Origine.xls").Activate
Chemin = ActiveWorkbook.Path
NomClasseur = ActiveWorkbook.Name
'Application.ScreenUpdating = False
 
'Programme de récupération des distances sur Google Map
Sheets("Canton-Commune").Activate
NColonne = Cells(1, 1).CurrentRegion.Columns.Count
NLigne = Cells(1, 1).CurrentRegion.Rows.Count
Cells(1, 23) = "Durée1"
Cells(1, 24) = "Durée2"
Cells(1, 25) = "Durée3"
Cells(1, 26) = "Durée4"
Cells(1, 27) = "Distance1"
Cells(1, 28) = "Distance2"
Cells(1, 29) = "Distance3"
Cells(1, 30) = "Distance4"
Cells(1, 31) = "Durée1 mn"
Cells(1, 32) = "Durée2 mn"
Cells(1, 33) = "Durée3 mn"
Cells(1, 34) = "Durée4 mn"
Cells(1, 35) = "Nom Mag Local" 'Priorité 2
Cells(1, 36) = "Code Mag Local"
Cells(1, 37) = "Durée Min Local"
Cells(1, 38) = "Index Mag Local"
Cells(1, 39) = "Nom Mag Régional" 'Priorité 1 - Magasins régionaux
Cells(1, 40) = "Code Mag régional"
Cells(1, 41) = "Durée Min régional"
Cells(1, 42) = "Index Mag Régional"
 
Sheets("Canton-Commune").Activate
    For i = 2 To NLigne
        For j = 1 To 4
            If Cells(i, 22 + j) = "" Then
                If UCase(Cells(i, 18 + j)) = UCase(Cells(i, 14)) Then 'On identifie l'égalité depart/arrivée
                Cells(i, 22 + j) = "0 mn"
                Cells(i, 26 + j) = "0"
                Else
                Arrivée = Cells(i, 14)
                Départ = Cells(i, 18 + j)
                Call Calcul(Arrivée, Départ)
                Sheets("Canton-Commune").Activate
                Cells(i, 22 + j) = Durée
                Cells(i, 26 + j) = Distance
                End If
            End If
        Next j
 
                    If i Mod 5000 = 0 And Cells(i + 1, 23) = "" Then 'On sauvegarde défiitivement tous les 5000 enregistrements
                    Application.DisplayAlerts = False
                    ActiveWorkbook.SaveAs Filename:=Chemin & "\" & i & NomClasseur
 
                    Application.DisplayAlerts = True
 
                    ElseIf i Mod 2000 = 0 And Cells(i + 1, 23) = "" Then 'On sauvegarde toutes les 1000 lignes si la ligne suivante n'a pas été rempli
                    Application.DisplayAlerts = False
                    ActiveWorkbook.SaveAs Filename:=Chemin & "\" & "2" & NomClasseur
                    Application.DisplayAlerts = True
 
                    ElseIf i Mod 1000 = 0 And Cells(i + 1, 23) = "" Then
                    Application.DisplayAlerts = False
                    ActiveWorkbook.SaveAs Filename:=Chemin & "\" & "1" & NomClasseur
                    Application.DisplayAlerts = True
                    End If
'z = z + 1
'If z = 50 Then
'MsgBox z
'z = 0
'End If
 
    Next i
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=Chemin & "\" & NomClasseur
Application.DisplayAlerts = True
'Application.ScreenUpdating = True
Windows("Application Maillage CBN Spare_V0.xls").Activate
ActiveSheet.Shapes.Range(Array("Rounded Rectangle 10")).Select
    Selection.ShapeRange.ShapeStyle = msoShapeStylePreset22
 
MsgBox ("Terminé")
End Sub

**lucasgaetan** · 05/11/2014, 16h17

pas mieux cher moi,
j'ai vider les variables, supprimer les QueryTables a chaque passage, rien n'y fait.

regarde ces deux poste:
http://www.developpez.net/forums/d14...nees-internet/
http://www.developpez.net/forums/d14...reezeplenteur/

je ne peux pas t'aider, dsl

a+

**grimgrim** · 05/11/2014, 21h20

au vu des tests que j'ai fait cet après midi, je programme fonctionne mais peu de fois et cela s'arrête

Je vais ensuite sur internet google directement et là on trouve une fenêtre de google demandant d'entrer un mot pour vérifier que je ne suis pas un automate
En réalité, je pense que google bloque après quelques requêtes. j'ai ensuite testé de supprimer l'historique du navigateur IE et j'ai pu récupérer une fois les données.
De lors j'ai de traduire en code la suppression de l'historique mais cela n'a pas fonctionné

Arrêt de programme Google Map

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager