Sub Multi_Destinations()
Dim ShtDep As Worksheet, ShtDes As Worksheet
Dim IncDes As Long, IncRqt As Long
Dim LigFinDep As Long, LigFinDes As Long, Col As Integer
Dim sLat As String, sLong As String
Dim PauseTime, Start
' Désactiver la checkbox de détail du parcours
' Ne sert à rien dans ce cas et fait gagner du temps
Sheets("Itinéraire").CheckBox1.Value = False
' Initialiser le numéro de la boucle
IncRqt = 0
' Définir la variable objet de la feuille Destinations
Set ShtDep = Sheets("Départs")
Set ShtDes = Sheets("Destinations")
Col = ShtDes.Columns("H").Column ' Colonne de la latitude
' Avec la feuille Itinéraire
With Sheets("Itinéraire")
' Vérifier si une saisie de coordonnées Latitude/Longitude à étgé faite
If .Range("DepLat").Value <> "" And .Range("DepLong").Value <> "" Then
sLat = Replace(.Range("DepLat").Value, ",", ".")
sLong = Replace(.Range("DepLong").Value, ",", ".")
.Range("DepVille").Value = sLat & "," & sLong
End If
' Vérifier que l'adresse de départ a bien été saisie
If .Range("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
' Trouver les lignes de fin de la feuille de Destinations
'LigFinDes = Application.Max(ShtDes.Range("F" & Rows.Count).End(xlUp).Row, ShtDes.Range("H" & Rows.Count).End(xlUp).Row)
' ### correction du 04/02/2014
'### ICI MA MODIF
LigFinDes = Application.Max(ShtDes.Range("F" & Rows.Count).End(xlUp).Row, ShtDes.Range("E" & Rows.Count).End(xlUp).Row, ShtDes.Range("H" & Rows.Count).End(xlUp).Row)
'### FIN MODIF
' Pour chaque adresse de destination
For IncDes = 2 To LigFinDes
' Afficher le calcul qui se fait
Application.StatusBar = "Calcul itinéraire :" & IncDes & "/" & LigFinDes - 1 & " destinations"
' Inscrire le nombre de requête calculée
.Range("NbRqt").Value = IncRqt
' Insère les adresses dans les cellules ou les coordonnées
' Si la colonne contient une coordonnée
If ShtDes.Cells(IncDes, Col) <> "" Then
' On effectue le calcul sur les coordonnées
sLat = Replace(ShtDes.Cells(IncDes, Col), ",", ".")
sLong = Replace(ShtDes.Cells(IncDes, Col + 1), ",", ".")
.Range("FinVille").Value = sLat & "," & sLong
Else
' sinon, calcul sur adresse
.Range("FinAdr").Value = ShtDes.Cells(IncDes, 4)
.Range("FinVille").Value = Format(ShtDes.Cells(IncDes, 5), "00000") & ", " & ShtDes.Cells(IncDes, 6)
End If
' lancer la macro pour calculer l'itinéraire
Call ItinéraireGoogle
' Incrire les bonnes valeurs (adresse + ville) dans la feuille itinéraire
Call InscriptionAdr
' Sauvegarde l'itinéraire dans la feuille sauvegarde
Call Sauvegarde
' temporisation
PauseTime = .Range("Tempo").Value ' Définit la durée
Start = Timer ' Définit l'heure de début
DoEvents
Do
Loop Until Timer > Start + PauseTime ' Définit la fin
' Incrémenter le nombe de requête calculée
IncRqt = IncRqt + 1
Next IncDes
End With
With Sheets("Sauvegarde")
.Activate
.Range("A" & 1 + IncDes).Select
End With
End Sub