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
120
| Option Explicit
Dim Chemin As String
Dim NomClasseur As String
Dim NomFeuille As String
Dim NColonne As Integer
Dim i As Long
Dim j As Long
Dim n As Long
Dim z As Integer
Dim NLigne As Long
Dim Départ As String
Dim Arrivée As String
Dim Result As Object
Dim Adresse As String
Dim Plage As Object
Public Durée As String
Public Distance As String
Dim NOK As String
Dim DuréeOK As Boolean
Dim DistanceOK As Boolean
Dim ConnectStr As String
Dim Département As Object
Dim DuréeMn As Integer
Dim NHeures As Integer
Dim NMinutes As Integer
Dim LDébutMinutes As Integer
Dim ColonneDuréeMin As Integer
Dim NbMagNiveau2 As Integer
Dim Nom As String
Dim Chargement As Boolean
Dim CodeMagasin As String
Dim RangMagasin As String
Dim NbMag As Integer
Dim PrésenceCalcul As Boolean
Dim NEssai As Integer
Dim Mag() As String
Dim NomMag() As String
Sub BDuréeDistance()
Windows("Maillage_CBN_Spare_Origine.xls").Activate
Chemin = ActiveWorkbook.Path
NomClasseur = ActiveWorkbook.Name
'Application.ScreenUpdating = False
'Programme de récupération des distances sur Google Map
Sheets("Canton-Commune").Activate
NColonne = Cells(1, 1).CurrentRegion.Columns.Count
NLigne = Cells(1, 1).CurrentRegion.Rows.Count
Cells(1, 23) = "Durée1"
Cells(1, 24) = "Durée2"
Cells(1, 25) = "Durée3"
Cells(1, 26) = "Durée4"
Cells(1, 27) = "Distance1"
Cells(1, 28) = "Distance2"
Cells(1, 29) = "Distance3"
Cells(1, 30) = "Distance4"
Cells(1, 31) = "Durée1 mn"
Cells(1, 32) = "Durée2 mn"
Cells(1, 33) = "Durée3 mn"
Cells(1, 34) = "Durée4 mn"
Cells(1, 35) = "Nom Mag Local" 'Priorité 2
Cells(1, 36) = "Code Mag Local"
Cells(1, 37) = "Durée Min Local"
Cells(1, 38) = "Index Mag Local"
Cells(1, 39) = "Nom Mag Régional" 'Priorité 1 - Magasins régionaux
Cells(1, 40) = "Code Mag régional"
Cells(1, 41) = "Durée Min régional"
Cells(1, 42) = "Index Mag Régional"
Sheets("Canton-Commune").Activate
For i = 2 To NLigne
For j = 1 To 4
If Cells(i, 22 + j) = "" Then
If UCase(Cells(i, 18 + j)) = UCase(Cells(i, 14)) Then 'On identifie l'égalité depart/arrivée
Cells(i, 22 + j) = "0 mn"
Cells(i, 26 + j) = "0"
Else
Arrivée = Cells(i, 14)
Départ = Cells(i, 18 + j)
Call Calcul(Arrivée, Départ)
Sheets("Canton-Commune").Activate
Cells(i, 22 + j) = Durée
Cells(i, 26 + j) = Distance
End If
End If
Next j
If i Mod 5000 = 0 And Cells(i + 1, 23) = "" Then 'On sauvegarde défiitivement tous les 5000 enregistrements
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=Chemin & "\" & i & NomClasseur
Application.DisplayAlerts = True
ElseIf i Mod 2000 = 0 And Cells(i + 1, 23) = "" Then 'On sauvegarde toutes les 1000 lignes si la ligne suivante n'a pas été rempli
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=Chemin & "\" & "2" & NomClasseur
Application.DisplayAlerts = True
ElseIf i Mod 1000 = 0 And Cells(i + 1, 23) = "" Then
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=Chemin & "\" & "1" & NomClasseur
Application.DisplayAlerts = True
End If
'z = z + 1
'If z = 50 Then
'MsgBox z
'z = 0
'End If
Next i
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=Chemin & "\" & NomClasseur
Application.DisplayAlerts = True
'Application.ScreenUpdating = True
Windows("Application Maillage CBN Spare_V0.xls").Activate
ActiveSheet.Shapes.Range(Array("Rounded Rectangle 10")).Select
Selection.ShapeRange.ShapeStyle = msoShapeStylePreset22
MsgBox ("Terminé")
End Sub |
