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
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
| Sub Recup_data_pour_STEP()
'Déclaration des variables
'
Dim nbr_step As Long
Dim Derlig_step As Long
Dim Derlig_extract As Long
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim y As Integer
Dim x As String
Dim Deliv_Target_Date As Variant
Dim statusBarInitial As Long
Dim ID_reseau(100)
Dim Tab_EXTRACT() As Variant
'
'Déclaration des variables relatives au check date
'
Dim check_Deliv_Target_Date As String
'
'Les fichiers "STEP.xlsm" et "Extract.xlsx" doivent être dans le même sous-dossier.
'
If MsgBox("'STEP.xlsm' and 'EXTRACT.xlsx' must be in the same subfolder (root folder)." & Chr(10) & Chr(10) & "Is that the case ?", vbYesNo, "Confirmation Request") = vbNo Then
MsgBox ("Thank you to place the two files (STEP.xlsm and extract.xlsx) in the same subfolder.")
Exit Sub
Else
End If
'
'Sablier
Application.Cursor = xlWait
'
'Affichage de toutes les colonnes y compris celles masquées
Cells.Select
Selection.EntireColumn.Hidden = False
'
'Exécution de la macro "Recuperation_Noms_sous_dossiers"
Call Recuperation_Noms_sous_dossiers
'
'Permet de ne pas avoir à cliquer sur OK à chaque fois que c'est demandé (msgbox). Ainsi la validation est automatique
Application.EnableEvents = False
nbr_step = 0
'
'On est dans le fichier "STEP.xlsm", onglet "FEUIL1"
'
'Recherche du numéro de la dernière ligne non vide en partant de B6 (dernier ID) --> Derlig_step
'Recherche du nombre de références ID en colonne B --> nbr_step
'
Derlig_step = Application.WorksheetFunction.CountA(Range("B:B")) + 4
MsgBox ("Derlig_step = ") & Derlig_step
nbr_step = Range("B6:B" & Derlig_step).SpecialCells(xlCellTypeVisible).Count
MsgBox ("Nbr_step =") & nbr_step
'Affichage dans une boite de dialogue du nombre de références ID
MsgBox ("You have " & nbr_step & " ID's references")
'Initialisation des compteurs (on part de la ligne 6)
i = 1
y = 6
'Boucle sur le nombre de références ID, nbr_step (remplissage du tableau)
statusBarInitial = Application.DisplayStatusBar
Application.DisplayStatusBar = True
'
'Affiche pendant 1 seconde un message, cette fenêtre disparait ensuite et la procédure se poursuit
'CreateObject("Wscript.shell").Popup "IN PROGRESS :" & Chr(10) & Chr(10) & "Data recovery for all IDs in the list !!", 2, "For information", vbInformation
'
'
While i <= nbr_step
Application.StatusBar = "Calcul en cours... " & i & " / " & nbr_step
DoEvents
'Activation du fichier "STEP.xlsm", on se place dans l'onglet "Feuil1"
Windows("STEP.xlsm").Activate
Sheets("Feuil1").Activate
'x correspond à la valeur de la cellule B6 (première valeur de la liste)
x = Range("B" & y).Value
'
'Affiche pendant 1 seconde le nom du fichier en cours de traitement, cette fenêtre disparait ensuite et la procédure se poursuit
CreateObject("Wscript.shell").Popup "PLEASE WAIT" & Chr(10) & Chr(10) & "File " & "Entry_Form_" & x & ".xlsm", 2, "For information", vbInformation
'
'Ouverture du fichier "Entry_Form_ID.....xlsm" situé dans le dossier racine auquel on rajoute le sous-dossier ID....
'Activation de l'onglet "ADD_INFOS"
Workbooks.Open Filename:=Dossier_racine & "\" & x & "\" & "Entry_Form_" & x & ".xlsm"
Sheets("ADD_INFOS").Activate
'
'S'il y a un message d'erreur alors aller à l'étiquette fin.
On Error GoTo fin
'-----------------------------------------------------------------------------
'
' Mise en mémoire de la "Delivery Target Date" du fichier "Entry_Form_ID.....xlsm".
' Celle-ci sera rapatriée dans le fichier "STEP.xlsm"
' On est toujours dans l'onglet "ADD_INFOS"
'
'-----------------------------------------------------------------------------
'
'------Deliv_Target_Date (H6)------
'
check_Deliv_Target_Date = IsDate(Range("H6").Value)
'MsgBox ("Deliv_Target_Date = ") & check_Deliv_Target_Date & Range("H6").Value
If check_Deliv_Target_Date Then
Deliv_Target_Date = Range("H6").Value
'MsgBox ("Deliv Target Date VRAI")
Else
'MsgBox ("Deliv Target Date FAUX")
Deliv_Target_Date = ""
'MsgBox ("Deliv_Target_Date = ") & Deliv_Target_Date
End If
'
'------------------------------------------------------------------------------
'
' Fin de mise en mémoire des données du fichier "Entry_Form_ID.....xlsm".
'
'------------------------------------------------------------------------------
'
'
'On active le fichier "STEP.xlsm" et on se mets dans l'onglet "Feuil1"
Windows("STEP.xlsm").Activate
Sheets("Feuil1").Activate
'
'
'On colle la valeur précédemment mise en mémoire dans le fichier "STEP.xlsm" (onglet "Feuil1")
'
'------Deliv_Target_Date------La formulation ci-dessous permet d'éviter l'inversion jour / mois
'
If IsDate(Deliv_Target_Date) Then
Range("I" & y).NumberFormat = ""
Range("I" & y).Value = CDate(Deliv_Target_Date)
Else
Range("I" & y).Value = Deliv_Target_Date
End If
'
'
y = y + 1
i = i + 1
'
'
'Fermer le fichier "Entry_Form_ID....xlsm" sans l'enregistrer (false)
Workbooks("Entry_Form_" & x & ".xlsm").Close False
Wend
Application.StatusBar = ""
Application.DisplayStatusBar = statusBarInitial
'
'
'Affiche pendant 1 seconde un message, cette fenêtre disparait ensuite et la procédure se poursuit
'CreateObject("Wscript.shell").Popup "Data recovery completed !!", 2, "For information", vbInformation
'
'------ ON OUVRE LE FICHIER "EXTRACT.xlsx" ET ON VA DANS L'ONGLET "owssvr" ------
'
Workbooks.Open Filename:=Dossier_racine & "\" & "extract.xlsx"
Sheets("owssvr").Activate
'
Derlig_extract = Range("A" & Rows.Count).End(xlUp).Row
MsgBox ("Derlig_extract = ") & Derlig_extract
'
'La ligne d'instruction ci-dessous suffit à elle seule pour remplir le tableau !!
'La zone mise en mémoire part de la 2ème ligne --> Range("A2") jusqu'à "derlig_extract - 1"
'Le tableau contient 23 colonnes et "derlig_extract - 1" lignes
'
Tab_EXTRACT = Range("A2").Resize(Derlig_extract - 1, 23).Value
'
'
'Fermer le fichier "Extract.xlsx" sans l'enregistrer (false)
Workbooks("Extract.xlsx").Close False
'
'
'On revient dans le fichier "STEP.xlsm" et on se mets dans l'onglet "Feuil1"
Windows("STEP.xlsm").Activate
Sheets("Feuil1").Activate
'
MsgBox ("Data storage from 'Extract.xlsx' file is complete. The repatriation of the data will begin. Please wait.")
'
'On colle les valeurs précédemment mises en mémoire
'
For j = 1 To Derlig_extract - 1
For k = 1 To 23
Cells(j + 5, k + 10) = Tab_EXTRACT(j, k)
Next
Next
'
'On masque les colonnes I à AJ et AL
Columns("I:AJ").Select
Selection.EntireColumn.Hidden = True
Columns("AL:AL").Select
Selection.EntireColumn.Hidden = True
'
Range("A1").Select
'
MsgBox ("Update finished !!")
'
Application.EnableEvents = True
'
'Exécution de la macro "SaveFile"
Call SaveFile
'
Application.Cursor = xlDefault
'
'Permet de sortir de la procédure et évite la gestion d'erreur (errorHandler), si la macro
's'est déroulée sans encombre.
'
Exit Sub
'
fin:
'
'Activation du fichier "STEP.xlsm", on se place dans l'onglet "Feuil1"
'
Windows("STEP.xlsm").Activate
Sheets("Feuil1").Activate
'
MsgBox ("Warning : Procedure interrupted due to error")
'
End Sub
Sub SaveFile()
Dim Filename As String
If MsgBox("Do you want to save 'STEP.xlsm' on your local drive ?", vbQuestion + vbYesNo, "Confirmation Request") = vbYes Then
Filename = "STEP_" & Format(Date, "yyyymmdd") & "_" & Format(Time, "hhmmss") & ".xlsm"
With Application.FileDialog(msoFileDialogSaveAs)
.Title = "Save File as"
.InitialFileName = Filename
.FilterIndex = 2 ' 1 = xlsx, 2 = xlsm, 3 = xlsb
.Show
.Execute
End With
End If
End Sub |
