'MODULE
Public Const wurl As String = "https://www.google.fr/maps/dir/"
Public Const Formula1 As String = "=STXT(Data!$A$30;CHERCHE("":"";Data!$A$30)+3;NBCAR(Data!$A$30)-CHERCHE("":"";Data!$A$30)-4)"
Public Const Formula2 As String = "=STXT(Data!$A$34;CHERCHE("":"";Data!$A$34)+3;NBCAR(Data!$A$34)-CHERCHE("":"";Data!$A$34)-4)"
'--------------------------------------------------
Private Sub CmdItineraire_Click()
Application.ScreenUpdating = False
Depart = TxtDepart.Value
Arrivee = TxtArrivee.Value
With Sheets("Data").QueryTables.Add(Connection:="URL;http://maps.google.fr/maps/api/directions/json?origin=" & Depart _
& "&destination=" & Arrivee & "&sensor=false", Destination:=Sheets("Data").Range("A1"))
.Name = "itinéraire"
.BackgroundQuery = True
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.Refresh BackgroundQuery:=False
End With
With Sheets("Data")
.Range("a30") = Trim(.Range("a30"))
.Range("a31") = Trim(.Range("a31"))
.Range("a34") = Trim(.Range("a34"))
End Wit
With Sheets("Resultats")
.Range("a2") = TxtDepart.Value
.Range("b2") = TxtArrivee.Value
.Range("c2").FormulaLocal = Formula1
.Range("d2").FormulaLocal = Formula2
LblKm.Caption = .Range("c2")
LblTemps.Caption = .Range("d2")
End With
LblKm.Caption = Replace(LblKm.Caption, "Â", "")
Sheets("Resultats").Range("c2") = LblKm.Caption
On Error Resume Next
Application.DisplayAlerts = False
dep = TxtDepart.Value
arr = TxtArrivee.Value
sep = "+" & "/"
Me.WebBrowser1.Navigate wurl & dep & sep & arr & sep
End Sub