Rapport Bilan Carbone de l'université Paris Diderot.

Annexe 5.6 : Scripts du calcul des distances totales via l’API GoogleMap
(Visual Basic sous Excel)
Sub traitement_distance(mws, Pretrait)
Dim val, k As Integer
Dim i, a As Long
Dim address1, address2, nomwb, addr As String
Dim city1, city2
Dim CP1, CP2 As String
Dim sendstring1, sendstring2, Depart, Arrivee As String
Dim oldstatusbar
Dim mywstempdist As Worksheet
oldstatusbar = Application.DisplayStatusBar
nomwb = ThisWorkbook.Name
a = firstligvide(mws, 1, 1)
Set mywstempdist = Workbooks(nomwb).Worksheets("TempDist")
'Prétraite la base pour compatibilité avec
requête Google Maps API
If Pretrait Then
Call pretraitement_adresse(mws, 5, a)
Call pretraitement_adresse(mws, 6, a)
End If
'Adresse de base (départ) : Université ici
address1 = mywsbdd.Cells(46, 1).Value
city1 = mywsbdd.Cells(46, 2).Value
CP1 = mywsbdd.Cells(46, 3).Value
address1 = Replace(address1, " ", "+", 1)
sendstring1 = address1 & ",+" & city1 & "+" & CP1
'Parcours de toutes les distances à trouver
For i = 862 To a
address2 = mws.Cells(i, 5).Value
city2 = mws.Cells(i, 6).Value
CP2 = mws.Cells(i, 7).Value
address2 = Replace(address2, " ", "+", 1)
If address2 = 0 Then
sendstring2 = city2 & "+" & CP2
ElseIf city2 = 0 Then
sendstring2 = CP2
Else
sendstring2 = address2 & ",+" & city2 & "+" & CP2
End If
Depart = sendstring1
Arrivee = sendstring2
'Calcul de la distance
Sheets("TempDist").Cells.Clear
With
Sheets("TempDist").QueryTables.Add(Connection:="URL;http://map
s.googleapis.com/maps/api/distancematrix/jsonorigins=" & Depart &
"&destinations=" & Arrivee & "&mode=car&language=fr-
FR&sensor=false", Destination:=Sheets("TempDist").Range("A1"))
.Name = "itinéraire"
.BackgroundQuery = True
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.Refresh BackgroundQuery:=False
For k = 1 To firstligvide(mywstempdist, 1, 1)
If InStr(1, mywstempdist.Cells(k, 1), "value", vbBinaryCompare) >
0 Then
mws.Cells(i, 34).Value = Mid(mywstempdist.Cells(k, 1),
InStr(1, mywstempdist.Cells(k, 1), ":", vbBinaryCompare) + 1) / 1000
Exit For
End If
Next k
End With
If IsEmpty(mws.Cells(i, 34)) Then
mws.Cells(i, 34) = "Itinéraire non trouvé"
End If
'Rapport du lien Google Maps utilisé
addr =
"http://maps.googleapis.com/maps/api/distancematrix/jsonorigins="
& Depart & "&destinations=" & Arrivee &
"&mode=car&language=fr-FR&sensor=false"
mywsrapport.Cells(i, 13) = addr
'Geocodage
Sheets("Temp").Cells.Clear
With
Sheets("Temp").QueryTables.Add(Connection:="URL;http://maps.go
ogle.com/maps/geoq=" & Arrivee &
"&output=csv&sensor=false&key=AIzaSyC3kWmzX4QTlgIGqJEcdN
88HB5tNTujl9k", Destination:=Sheets("Temp").Range("A1"))
.Name = "itinéraire"
.BackgroundQuery = True
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.Refresh BackgroundQuery:=False
End With
'Renvoie de la requête de géocodage dans le
rapport de traitement
Sheets("Rapport de Traitement").Range(mywsrapport.Cells(i, 9),
mywsrapport.Cells(i, 12)) = Split(Sheets("Temp").Cells(1, 1).Value,
",", 4)
mywsrapport.Cells(i, 6) = address2
mywsrapport.Cells(i, 7) = city2
mywsrapport.Cells(i, 8) = CP2
'Modif de la StatusBar
Application.DisplayStatusBar = True
Application.StatusBar = "Traitement des distances : " & i & "/" & a &
" - " & mws.Cells(i, 34).Value
Next i
'Remise en place de l'ancienne StatusBar
Application.StatusBar = False
Application.DisplayStatusBar = oldstatusbar
End Sub
‘Routine Prétraitement pour compatibilité
GoogleMap API
Sub pretraitement_adresse(mws, col, lastlig)
Dim i As Integer
Dim oldstatusbar
oldstatusbar = Application.DisplayStatusBar
For i = 1 To lastlig
mws.Cells(i, col) = Replace(mws.Cells(i, col), "é", "e", 1)
mws.Cells(i, col) = Replace(mws.Cells(i, col), "è", "e", 1)
mws.Cells(i, col) = Replace(mws.Cells(i, col), "ç", "c", 1)
142 Université Paris Diderot – Paris 7 Paris Diderot Développement Durable