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 |
