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
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
|
Public Sub Import() 'En test Import Automatique
Dim oApp As New Excel.Application
Dim oWkb As New Excel.Workbook
Dim oWSht As New Excel.Worksheet 'feuille de calcul
Dim fDlg As Office.FileDialog
Dim strFichier As String
Dim cSQL As String
Dim cSQL22 As String
Dim csql2 As String
Dim c2SQL4 As String
Dim c3SQL4 As String
Dim cSQL444 As String
Dim cSQL4444 As String
Dim cSQL445 As String
Dim c3SQL5 As String
Dim cSQL4445 As String
Dim cSQL4446 As String
Dim c3SQL6 As String
Dim cSQL446 As String
Dim c3SQL7 As String
Dim cSQL447 As String
Dim nbre_col As Integer
Dim NomFic As String
Dim i As Integer
Dim Prov As Boolean
Dim num_col, lettre_col As Variant
Dim strCellModifiee As String
' Variables pour Import Excel
Dim NumDemRef As Integer
Dim NumDemNRef As Integer
Dim TypeDem_Etoile As Integer
Dim TypeDem As Integer
Dim DateDem As Integer
Dim LivAtt As Integer
Dim Service As Integer
Dim N_Archives As Integer
Dim AncienNum As Integer
Dim NomMed As Integer
Dim SECTEUR As Integer
Dim Descr As Integer
Dim DateDeb As Integer
Dim DateClot As Integer
Dim NIP As Integer
Dim NomFam As Integer
Dim NomUsage As Integer
Dim Prenom As Integer
Dim DateNaiss As Integer
Dim DateDC As Integer
Dim Sexe As Integer
Dim UG_DEST As Integer
Dim CommDem As Integer
Dim InfosComp As Integer
Dim NumCont As Integer
Dim Empl As Integer
Dim Change As Boolean
' Valeur de la cellule Excel importée
Dim valCel As String
Dim valCelReel As String
' Tableau des valeurs positions des colonnes fichier Excel importé
Dim Tableau As Currency
Dim iT As Integer
'Copie du fichier Exporté d'Excel
' Ouverture du fichier Excel
Set oWkb = oApp.Workbooks.Open(DLookup("[CHEMIN_FICHIER_IMPORT]", "TAB_PARAMETRE") & DLookup("[NOM_FICHIER_IMPORT]", "TAB_PARAMETRE"))
Set oWSht = oWkb.Worksheets(DLookup("[ONGLET_FICHIER_IMPORT]", "TAB_PARAMETRE")) ' le nom de la feuille qui contient les données à importer
On Error GoTo Ges_Err
oWSht.Range("A" & 1).Select
num_col = oWSht.Range("A" & 1).Column 'num_col=1
lettre_col = NumCol2Lettre(num_col) 'lettre_col="A"
While oWSht.Range(lettre_col & 1) <> ""
valCel = oWSht.Range(lettre_col & 1).Value
Select Case num_col 'voir case 9
Case 1
If valCel = "N° de demande" Then
NumDemRef = num_col
Else 'cas jamais arrivé ou libéllé différent je ne traite pas pour le moment
Change = True
End If
Case 2
If valCel = "N° de demande" Then
NumDemNRef = num_col
Else 'cas jamais arrivé ou libéllé différent je ne traite pas pour le moment
End If
Case 3
If valCel = "Type de la demande *" Then
TypeDem_Etoile = num_col
Else 'cas jamais arrivé ou libéllé différent je ne traite pas pour le moment
valCelReel = "Type de la demande *"
TypeDem_Etoile = ReelNumCol(valCelReel)
End If
Case 4
If valCel = "Type de la demande" Then
TypeDem = num_col
Else 'cas ou libéllé différent
valCelReel = "Type de la demande"
TypeDem = ReelNumCol(valCelReel)
End If
Case 5
If valCel = "Date demande" Then
DateDem = num_col
Else 'cas ou libéllé différent
valCelReel = "Date demande"
DateDem = ReelNumCol(valCelReel)
End If
Case 6
If valCel = "Livraison attendue" Then
LivAtt = num_col
Else 'cas ou libéllé différent
valCelReel = "Livraison attendue"
TypeDem = ReelNumCol(valCelReel)
End If
Case 7
If valCel = "Service" Then
Service = num_col
Else 'cas ou libéllé différent
valCelReel = "Service"
Service = ReelNumCol(valCelReel)
End If
Case 8
If valCel = "N° archives" Then
N_Archives = num_col
Else 'cas ou libéllé différent
valCelReel = "N° archives"
N_Archives = ReelNumCol(valCelReel)
End If
Case 9
If valCel = "Ancien numéro" Then
AncienNum = num_col
Else 'cas ou libéllé différent
valCelReel = "Ancien numéro"
AncienNum = ReelNumCol(valCelReel)
End If
end select
num_col = Range(lettre_col & 1).Column + 1
lettre_col = NumCol2Lettre(num_col)
oWSht.Range(lettre_col & 1).Select
wend
i = 2
DoCmd.SetWarnings False
MsgBox ("Importation en cours ")
'arrêter l'importation lorsque le programme rencontre une case vide en remplaçant la ligne du While par :
While oWSht.Range("A" & i).Value <> "" Or oWSht.Range("B" & i).Value <> "" '(où I représente la colonne et i la ligne)
cSQL = "insert into [TAB_IMPORT] ( [EMPLACEMENT], [NUM_CONTENANT], [NUM_ARCHIVES], [SECTEUR],[Date_Liv_Att], [SERVICE],[NIP],[NOM_DE_FAMILLE],[NOM_D_USAGE],[PRENOM],[DATE_NAISS],[SEXE], [DESCRIPTIF], [UG_DEST],[COMM],[Infos_Compl], [NUM_DEMANDE], [ARMOIRE], [SALLE])" & _
"values ("
cSQL = cSQL & Chr(34) & oWSht.Cells(i, Empl) & Chr(34) 'Emplacement (21)
cSQL = cSQL & ", " & Chr(34) & oWSht.Cells(i, NumCont) & Chr(34) 'Num contenant (20)
If oWSht.Cells(i, 8).Value <> "" Then
cSQL = cSQL & ", " & Chr(34) & oWSht.Cells(i, N_Archives) & Chr(34) 'Num archives
Else
cSQL = cSQL & ", " & Chr(34) & oWSht.Cells(i, AncienNum) & Chr(34) 'Num archives Non Réf
End If
Match_Insertions oWSht.Cells(i, 27), oWSht.Cells(i, N_Archives) 'Emplacement dossier et N° Dossier
'Permet de voir si sur ce Dossier de voir s'il existe une Insertion
'Si oui met à jour Date_Trait sur la table Insertion
'à la date du jour
cSQL = cSQL & ", " & Chr(34) & oWSht.Cells(i, SECTEUR) & Chr(34) 'Secteur (10)
cSQL = cSQL & ", " & Chr(34) & oWSht.Cells(i, LivAtt) & Chr(34) 'Date Liv Atendue
cSQL = cSQL & ", " & Chr(34) & Right(oWSht.Cells(i, Service), 6) & Chr(34) 'Service (7)
cSQL = cSQL & ", " & Chr(34) & oWSht.Cells(i, NIP) & Chr(34) 'NIP
cSQL = cSQL & ", " & Chr(34) & oWSht.Cells(i, NomFam) & Chr(34) 'Nom de FAmille
cSQL = cSQL & ", " & Chr(34) & oWSht.Cells(i, NomUsage) & Chr(34) 'Nom d'usage
cSQL = cSQL & ", " & Chr(34) & oWSht.Cells(i, Prenom) & Chr(34) 'Prénom
cSQL = cSQL & ", " & Chr(34) & oWSht.Cells(i, DateNaiss) & Chr(34) 'Date de Naissance
cSQL = cSQL & ", " & Chr(34) & Left(oWSht.Cells(i, Sexe), 1) & Chr(34) 'Sexe (18)
cSQL = cSQL & ", " & Chr(34) & oWSht.Cells(i, Descr) & Chr(34) 'Descriptif (11)
cSQL = cSQL & ", " & Chr(34) & Left(oWSht.Cells(i, UG_DEST), 8) & Chr(34) 'UG destinataire (19)
' Gestion des caractères spéciaux guillemets pour le champ Commentaires et Infos Compl
If InStr(oWSht.Cells(i, CommDem), """") <> 0 Then
strCellModifiee = oWSht.Cells(i, CommDem)
cSQL = cSQL & ", " & Chr(34) & Replace(strCellModifiee, """", " ") & Chr(34) 'Commentaires
Else
cSQL = cSQL & ", " & Chr(34) & oWSht.Cells(i, CommDem) & Chr(34) 'Commentaires
End If
If InStr(oWSht.Cells(i, InfosComp), """") <> 0 Then
strCellModifiee = oWSht.Cells(i, InfosComp)
cSQL = cSQL & ", " & Chr(34) & Replace(strCellModifiee, """", " ") & Chr(34) 'Infos Compl
Else
cSQL = cSQL & ", " & Chr(34) & oWSht.Cells(i, InfosComp) & Chr(34) 'Infos Compl
End If If oWSht.Range("A" & i).Value <> "" Then
cSQL = cSQL & ", " & Chr(34) & oWSht.Cells(i, NumDemRef) & Chr(34) 'Num Demande
Else
cSQL = cSQL & ", " & Chr(34) & oWSht.Cells(i, NumDemNRef) & Chr(34) 'Num Demande
End If
cSQL = cSQL & "," & "NULL"
cSQL = cSQL & "," & "NULL"
cSQL = cSQL & ");"
DoCmd.RunSQL cSQL
'Code 128
If oWSht.Cells(i, NumDemRef) <> "" Then
strCellModifiee = oWSht.Cells(i, 1)
cSQL22 = "UPDATE [TAB_IMPORT] Set [TAB_IMPORT].[Num128]='" & Replace(Code128$(strCellModifiee), "'", "''") & "'" & ""
cSQL22 = cSQL22 & "where Tab_Import.Num_Demande='" & Replace(strCellModifiee, "'", "''") & "'" & ";"
DoCmd.RunSQL cSQL22
Else
strCellModifiee = oWSht.Cells(i, NumDemNRef)
cSQL22 = "UPDATE [TAB_IMPORT] Set [TAB_IMPORT].[Num128]='" & Replace(Code128$(strCellModifiee), "'", "''") & "'" & ""
cSQL22 = cSQL22 & "where Tab_Import.Num_Demande='" & Replace(strCellModifiee, "'", "''") & "'" & ";"
DoCmd.RunSQL cSQL22
End If
'Fin Code 128
i = i + 1
csql2 = "UPDATE [TAB_IMPORT] INNER JOIN [TAB_UG] ON [TAB_IMPORT].[UG_DEST] = [TAB_UG].[UG] SET [TAB_IMPORT].[ARMOIRE] = [TAB_UG].[ARMOIRE]"
csql2 = csql2 & "WHERE [TAB_IMPORT.UG_DEST]=[TAB_UG.UG];"
DoCmd.RunSQL csql2
Wend
MsgBox ("Importation terminée ")
'Edition Détail des Demandes
'Insertion totale dans TAB_IMPORT2"
c2SQL4 = "insert into [TAB_IMPORT2] "
c2SQL4 = c2SQL4 & "SELECT * from TAB_IMPORT; "
DoCmd.RunSQL c2SQL4
'MDM
c3SQL4 = "insert into [TAB_COUNT_UG2] ( [UG], [NB])"
c3SQL4 = c3SQL4 & "SELECT TAB_IMPORT2.UG_DEST, Count(TAB_IMPORT2.UG_DEST) "
c3SQL4 = c3SQL4 & "from [TAB_IMPORT2] where TAB_IMPORT2.EMPLACEMENT LIKE 'BCA.MDM*' "
c3SQL4 = c3SQL4 & "group by TAB_IMPORT2.UG_DEST"
c3SQL4 = c3SQL4 & ";"
DoCmd.RunSQL c3SQL4
cSQL444 = "update [TAB_IMPORT2] "
cSQL444 = cSQL444 & "set[TAB_IMPORT2].[SALLE]= 'MDM ' where TAB_IMPORT2.EMPLACEMENT LIKE 'BCA.MDM*' "
cSQL444 = cSQL444 & ";"
DoCmd.RunSQL cSQL444
cSQL4444 = "update [TAB_COUNT_UG2] "
cSQL4444 = cSQL4444 & "set[TAB_COUNT_UG2].[SALLE]= 'MDM ' "
cSQL4444 = cSQL4444 & ";"
DoCmd.RunSQL cSQL4444
cSQL4444 = "delete from [TAB_IMPORT2] "
cSQL4444 = cSQL4444 & "where [TAB_IMPORT2].[SALLE]= 'MDM ' ;"
DoCmd.RunSQL cSQL4444
DoCmd.Requery
'NT
c3SQL5 = "insert into [TAB_COUNT_UG2] ( [UG], [NB])"
c3SQL5 = c3SQL5 & "SELECT TAB_IMPORT2.UG_DEST, Count(TAB_IMPORT2.UG_DEST) "
c3SQL5 = c3SQL5 & "from [TAB_IMPORT2] where TAB_IMPORT2.EMPLACEMENT LIKE '*NT*' "
c3SQL5 = c3SQL5 & "group by TAB_IMPORT2.UG_DEST"
c3SQL5 = c3SQL5 & ";"
DoCmd.RunSQL c3SQL5
DoCmd.Requery
cSQL445 = "update [TAB_IMPORT2] "
cSQL445 = cSQL445 & "set[TAB_IMPORT2].[SALLE]= 'Non Trouvés ' where TAB_IMPORT2.EMPLACEMENT LIKE '*NT*' "
cSQL445 = cSQL445 & ";"
DoCmd.RunSQL cSQL445
cSQL4445 = "update [TAB_COUNT_UG2] "
cSQL4445 = cSQL4445 & "set[TAB_COUNT_UG2].[SALLE]= 'Non Trouvés ' "
cSQL4445 = cSQL4445 & "where [TAB_COUNT_UG2].[SALLE] is Null "
cSQL4445 = cSQL4445 & ";"
DoCmd.RunSQL cSQL4445
cSQL4446 = "delete from [TAB_IMPORT2] "
cSQL4446 = cSQL4446 & "where [TAB_IMPORT2].[SALLE]= 'Non Trouvés ' ;"
DoCmd.RunSQL cSQL4446
DoCmd.Requery
'Non référencés
c3SQL6 = "insert into [TAB_COUNT_UG2] ( [UG], [NB])"
c3SQL6 = c3SQL6 & "SELECT TAB_IMPORT2.UG_DEST, Count(TAB_IMPORT2.UG_DEST) "
c3SQL6 = c3SQL6 & "from [TAB_IMPORT2] where TAB_IMPORT2.EMPLACEMENT LIKE 'TAMPON_SPARK' or TAB_IMPORT2.EMPLACEMENT=' ' "
c3SQL6 = c3SQL6 & "group by TAB_IMPORT2.UG_DEST"
c3SQL6 = c3SQL6 & ";"
DoCmd.RunSQL c3SQL6
cSQL446 = "update [TAB_IMPORT2] "
cSQL446 = cSQL446 & "set[TAB_IMPORT2].[SALLE]= 'Non Référencés ' where TAB_IMPORT2.EMPLACEMENT LIKE 'TAMPON_SPARK' or TAB_IMPORT2.EMPLACEMENT=' ' "
cSQL446 = cSQL446 & ";"
DoCmd.RunSQL cSQL446
cSQL4445 = "update [TAB_COUNT_UG2] "
cSQL4445 = cSQL4445 & "set[TAB_COUNT_UG2].[SALLE]= 'Non Référencés ' "
cSQL4445 = cSQL4445 & "where [TAB_COUNT_UG2].[SALLE] is Null "
cSQL4445 = cSQL4445 & ";"
DoCmd.RunSQL cSQL4445
cSQL4446 = "delete from [TAB_IMPORT2] "
cSQL4446 = cSQL4446 & "where [TAB_IMPORT2].[SALLE]= 'Non Référencés ' ;"
DoCmd.RunSQL cSQL4446
DoCmd.Requery
'VH,WS & MZ
c3SQL7 = "insert into [TAB_COUNT_UG2] ( [UG], [NB])"
c3SQL7 = c3SQL7 & "SELECT TAB_IMPORT2.UG_DEST, Count(TAB_IMPORT2.UG_DEST) "
c3SQL7 = c3SQL7 & "from [TAB_IMPORT2] where TAB_IMPORT2.EMPLACEMENT LIKE 'BCA.VH*' or TAB_IMPORT2.EMPLACEMENT LIKE 'BCA.WS*' "
c3SQL7 = c3SQL7 & "or TAB_IMPORT2.EMPLACEMENT Like 'BCA.MZ*' "
c3SQL7 = c3SQL7 & "group by TAB_IMPORT2.UG_DEST"
c3SQL7 = c3SQL7 & ";"
DoCmd.RunSQL c3SQL7
cSQL447 = "update [TAB_IMPORT2] "
cSQL447 = cSQL447 & "set[TAB_IMPORT2].[SALLE]= 'VH,WS & MZ ' where TAB_IMPORT2.EMPLACEMENT LIKE 'BCA.VH*' or TAB_IMPORT2.EMPLACEMENT LIKE 'BCA.WS*' "
cSQL447 = cSQL447 & "or TAB_IMPORT2.EMPLACEMENT Like 'BCA.MZ*' "
cSQL447 = cSQL447 & ";"
DoCmd.RunSQL cSQL447
cSQL4445 = "update [TAB_COUNT_UG2] "
cSQL4445 = cSQL4445 & "set[TAB_COUNT_UG2].[SALLE]= 'VH,WS & MZ ' "
cSQL4445 = cSQL4445 & "where [TAB_COUNT_UG2].[SALLE] is Null "
cSQL4445 = cSQL4445 & ";"
DoCmd.RunSQL cSQL4445
cSQL4446 = "delete from [TAB_IMPORT2] "
cSQL4446 = cSQL4446 & "where [TAB_IMPORT2].[SALLE]= 'VH,WS & MZ ' ;"
DoCmd.RunSQL cSQL4446
DoCmd.Requery
'EV
c3SQL4 = "insert into [TAB_COUNT_UG2] ( [UG], [NB])"
c3SQL4 = c3SQL4 & "SELECT TAB_IMPORT2.UG_DEST, Count(TAB_IMPORT2.UG_DEST) "
c3SQL4 = c3SQL4 & "from [TAB_IMPORT2] where TAB_IMPORT2.EMPLACEMENT = 'EV.EV' "
c3SQL4 = c3SQL4 & "group by TAB_IMPORT2.UG_DEST"
c3SQL4 = c3SQL4 & ";"
DoCmd.RunSQL c3SQL4
cSQL444 = "update [TAB_IMPORT2] "
cSQL444 = cSQL444 & "set[TAB_IMPORT2].[SALLE]= 'EV' where TAB_IMPORT2.EMPLACEMENT = 'EV' "
cSQL444 = cSQL444 & ";"
DoCmd.RunSQL cSQL444
cSQL4444 = "update [TAB_COUNT_UG2] "
cSQL4444 = cSQL4444 & "set[TAB_COUNT_UG2].[SALLE]= 'EV' "
cSQL4444 = cSQL4444 & "where [TAB_COUNT_UG2].[SALLE] is Null "
cSQL4444 = cSQL4444 & ";"
DoCmd.RunSQL cSQL4444
cSQL4445 = "delete from [TAB_IMPORT2] "
cSQL4445 = cSQL4445 & "where [TAB_IMPORT2].[SALLE]= 'EV' ;"
DoCmd.RunSQL cSQL4445
DoCmd.Requery
'PEL SIM
c3SQL4 = "insert into [TAB_COUNT_UG2] ( [UG], [NB])"
c3SQL4 = c3SQL4 & "SELECT TAB_IMPORT2.UG_DEST, Count(TAB_IMPORT2.UG_DEST) "
c3SQL4 = c3SQL4 & "from [TAB_IMPORT2] where TAB_IMPORT2.EMPLACEMENT = 'PEL SIM' "
c3SQL4 = c3SQL4 & "group by TAB_IMPORT2.UG_DEST"
c3SQL4 = c3SQL4 & ";"
DoCmd.RunSQL c3SQL4
cSQL444 = "update [TAB_IMPORT2] "
cSQL444 = cSQL444 & "set[TAB_IMPORT2].[SALLE]= 'PEL SIM' where TAB_IMPORT2.EMPLACEMENT = 'PEL SIM' "
cSQL444 = cSQL444 & ";"
DoCmd.RunSQL cSQL444
cSQL4444 = "update [TAB_COUNT_UG2] "
cSQL4444 = cSQL4444 & "set[TAB_COUNT_UG2].[SALLE]= 'PEL SIM' "
cSQL4444 = cSQL4444 & "where [TAB_COUNT_UG2].[SALLE] is Null "
cSQL4444 = cSQL4444 & ";"
DoCmd.RunSQL cSQL4444
cSQL4445 = "delete from [TAB_IMPORT2] "
cSQL4445 = cSQL4445 & "where [TAB_IMPORT2].[SALLE]= 'PEL SIM' ;"
DoCmd.RunSQL cSQL4445
DoCmd.Requery
'HL SIM CARDIO
c3SQL4 = "insert into [TAB_COUNT_UG2] ( [UG], [NB])"
c3SQL4 = c3SQL4 & "SELECT TAB_IMPORT2.UG_DEST, Count(TAB_IMPORT2.UG_DEST) "
c3SQL4 = c3SQL4 & "from [TAB_IMPORT2] where TAB_IMPORT2.EMPLACEMENT = 'HL SIM CARDIO' "
c3SQL4 = c3SQL4 & "group by TAB_IMPORT2.UG_DEST"
c3SQL4 = c3SQL4 & ";"
DoCmd.RunSQL c3SQL4
cSQL444 = "update [TAB_IMPORT2] "
cSQL444 = cSQL444 & "set[TAB_IMPORT2].[SALLE]= 'HL SIM CARDIO' where TAB_IMPORT2.EMPLACEMENT = 'HL SIM CARDIO' "
cSQL444 = cSQL444 & ";"
DoCmd.RunSQL cSQL444
cSQL4444 = "update [TAB_COUNT_UG2] "
cSQL4444 = cSQL4444 & "set[TAB_COUNT_UG2].[SALLE]= 'HL SIM CARDIO' "
cSQL4444 = cSQL4444 & "where [TAB_COUNT_UG2].[SALLE] is Null "
cSQL4444 = cSQL4444 & ";"
DoCmd.RunSQL cSQL4444
cSQL4445 = "delete from [TAB_IMPORT2] "
cSQL4445 = cSQL4445 & "where [TAB_IMPORT2].[SALLE]= 'HL SIM CARDIO' ;"
DoCmd.RunSQL cSQL4445
DoCmd.Requery
'Transferts
c3SQL4 = "insert into [TAB_COUNT_UG2] ( [UG], [NB])"
c3SQL4 = c3SQL4 & "SELECT TAB_IMPORT2.UG_DEST, Count(TAB_IMPORT2.UG_DEST) "
c3SQL4 = c3SQL4 & "from [TAB_IMPORT2] where TAB_IMPORT2.EMPLACEMENT = 'BCA.TRANSFERTS' "
c3SQL4 = c3SQL4 & "group by TAB_IMPORT2.UG_DEST"
c3SQL4 = c3SQL4 & ";"
DoCmd.RunSQL c3SQL4
cSQL444 = "update [TAB_IMPORT2] "
cSQL444 = cSQL444 & "set[TAB_IMPORT2].[SALLE]= 'HL SIM CARDIO' where TAB_IMPORT2.EMPLACEMENT = 'BCA.TRANSFERTS' "
cSQL444 = cSQL444 & ";"
DoCmd.RunSQL cSQL444
cSQL4444 = "update [TAB_COUNT_UG2] "
cSQL4444 = cSQL4444 & "set[TAB_COUNT_UG2].[SALLE]= 'BCA.TRANSFERTS' "
cSQL4444 = cSQL4444 & "where [TAB_COUNT_UG2].[SALLE] is Null "
cSQL4444 = cSQL4444 & ";"
DoCmd.RunSQL cSQL4444
cSQL4445 = "delete from [TAB_IMPORT2] "
cSQL4445 = cSQL4445 & "where [TAB_IMPORT2].[SALLE]= 'BCA.TRANSFERTS' ;"
DoCmd.RunSQL cSQL4445
DoCmd.Requery
'A REMETTRE Call EditerDetDem 'Edition Détail des Demandes
MsgBox ("Edition Détails des Demandes en cours... ")
oApp.Quit 'Appli Excel
' Libère la mémoire des Objets oWSht,oWkb,oApp
Set oWSht = Nothing 'feuille de calcul libère le pointeur
Set oWkb = Nothing 'Classeur libère le pointeur
Set oApp = Nothing 'libère le pointeur
DoCmd.OpenForm "Formulaire_VISU_IMPORT"
FinGes_err:
Exit Sub
Ges_Err:
If err.Number = 3340 Then
Resume Next
Else
MsgBox err.Description
Resume Next
End If
End Sub |
