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
   | 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
PointDépart = "01400 - L'Abergement-Clémenciat Châtillon-sur-Chalaronne"
PointArrivée = "69120 - VAULX EN VELIN"
 
    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"
        .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, "km,") + 3)
                      DuréeOK = True
                      End If
                      If InStr(Result, "km") And DistanceOK = False Then
                      Distance = Result
                      Distance = Left(Distance, InStr(Distance, "km,") - 1)
                      DistanceOK = True
                      End If
                  Else
                      Durée = "0 minutes"
                      Distance = "0 km"
                      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 | 
Partager