Gerer processus Excel depuis Access

**xeron33** · 15/02/2023, 14h29

Bonjour à tous,
J'accède depuis une application Access à un classeur Excel via ce code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

La procedure appelée ReelNumCol renvoie la valeur de la colonne et Fct_KillExcel tue le process Excel

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Function Fct_KillExcel()

Dim sKillExcel As String

sKillExcel = "TASKKILL /F /IM Excel.exe"
Shell sKillExcel, vbHide

End Function
Public Function ReelNumCol(ValLibCol As String) As Integer
    Dim oApp As New Excel.Application
    Dim oWkb As New Excel.Workbook
    Dim oWSht As New Excel.Worksheet 'feuille de calcul
    Dim num_col, lettre_col As Variant
    Dim valCel As String

    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"
    valCel = oWSht.Range(lettre_col & 1).Value

    While oWSht.Range(lettre_col & 1) <> ""
      If valCel <> ValLibCol Then
        num_col = oWSht.Range(lettre_col & 1).Column + 1
        lettre_col = NumCol2Lettre(num_col)
        oWSht.Range(lettre_col & 1).Selec
        ReelNumCol = num_col
        oWSht.Range(lettre_col & 1) = ""
      End If
        If oWSht.Range(lettre_col & 1) <> "" Then
          valCel = oWSht.Range(lettre_col & 1).Value
        End If
    Wend
    oApp.Quit  'Appli Excel
    Set oWSht = Nothing   'feuille de calcul libère le pointeur
    Set oWkb = Nothing   'Classeur libère le pointeur
    Set oApp = Nothing  'Application libère le pointeur
    'Suppression du fichier Exporté d'Excel
   Fct_KillExcel

'FinGes_err:
  Exit Function
Ges_Err:
  If err.Number = 3340 Then
     MsgBox "err 3340"
     Resume Next
   Else
     MsgBox err.Description & err.Number
 '    vbOKOnly + vbCritical, _
  '   "Fermeture Fichier Excel ! "
 '   Resume next FinGes_err
     Resume Next
  End If
End Function

Le problème que j'ai est que une fois le processus "tué" je n'arrive pas à le regénérer une fois retourné dans la procedure appelante :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
Public Sub Import() 'En test Import Automatique

Le processus est crée comme ceci :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
 
    Dim oApp As New Excel.Application
    Dim oWkb As New Excel.Workbook
    Dim oWSht As New Excel.Worksheet 'feuille de calcul
 
            '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

Si quelqu'un a une idée....

**Thumb down** · 15/02/2023, 15h51

Bonjour,
tu nous fais un orgie de variables, ça rend ton code incompréhensible!

pour quitter Excel oApp.quit

**xeron33** · 15/02/2023, 18h59

Merci pour ta réponse, en effet bcp de variables mais je les ait bien isolé du traitement ca devrait pas poser de problème à la lecture, pour ton info
oApp.quit je l'utilise en ligne 407 de la procedure

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
Public Sub Import() 'En test Import Automatique

Merci en tout cas
A+

**Thumb down** · 15/02/2023, 19h10

Fct_KillExcel tue le process Excel

A vrai dire quand ça dépasse 326 lignes je vais pas plus loin !

**tee_grandbois** · 15/02/2023, 19h16

bonsoir,

Envoyé par Thumb down

A vrai dire quand ça dépasse 326 lignes je vais pas plus loin !

complètement d'accord avec toi d'autant plus que cette (mauvaise) idée de modifier le code posté en ajoutant du gras supprime la colorisation syntaxique

**deedolith** · 15/02/2023, 19h35

Merci pour ta réponse, en effet bcp de variables mais je les ait bien isolé du traitement ca devrait pas poser de problème à la lecture, pour ton info
oApp.quit je l'utilise en ligne 407 de la procedure

Ben non justement,
ta fonction viole le SRP (https://en.wikipedia.org/wiki/Single...lity_principle).
En clair: elle fait trop de choses, ce qui la rend particulièrement difficile à comprendre et maintenir (c'est un fourre-tout).

**deedolith** · 15/02/2023, 21h15

Après avoir regardé de plus près (et ca va être saignant), ta fonction import fait:
- Ouverture du fichier (pas son job).
- Contrôle des entêtes (pas son job).
- Contrôle des données (pas son job).
- Insertions dans la table TAB_IMPORT.
- Mise à jour de plein d'autres tables (pas son job)
- Tue Excel (avec tous les risques qui vont avec, et ce n''est pas son job).
- Fais des popups (pas son job).
Par respect du SRP, chacun de ces points devrait apparaitre dans une fonction dédiée.

De plus, pourquoi tu te fait chier à contrôler cellule par cellule ? C'est lent et d'une inefficacité redoutable.
Fait un transfertspreadsheet, et manipule la table résultante, ce sera beaucoup mieux (et plus besoin de se soucier d'Excel).

Egalement, si ton fichier source à un "soucis", un import partiel est réalisé, mais il n'y a aucun retour pour l'utilisateur (démerdes-toi pour comprendre pourquoi tu n'as pas toutes tes données !!!).

La notation hongroise, je ne suis pas fan:
https://www.developpez.net/forums/d2...groise-contre/

Revoit tes noms de variable, il sont tout sauf parlant (un bon nom doit refléter son rôle rien qu'en le lisant).

Utilises les constantes plutôt, ce sera plus lisible (vbCrLf, vbNullString par exemple).

CurrentDb.Execute(sql, dbFailOnError) est à préférer à doCmd.Run(sql). La fonction Run ne donne aucun retour en cas d'échec (et tu te demanderas ou sont passées tes données).

**xeron33** · 19/02/2023, 10h14

Envoyé par deedolith

De plus, pourquoi tu te fait chier à contrôler cellule par cellule ? C'est lent et d'une inefficacité redoutable.
Fait un transfertspreadsheet, et manipule la table résultante, ce sera beaucoup mieux (et plus besoin de se soucier d'Excel).

Bonjour merci pour ta réponse, j'ai revu le problème et j'ai lié la table excel à une table Access "TAB_Inport_Exc". J'ai lu un peu la doc sur les Objet Field (DAO) qui me permettrait avec la méthode OrdinalPosition de me renvoyer le numéro de colonne du champ. Voici mon code pour déclarer mes objets TableDef et Field (je suis sous Access 2010)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
 
    Dim fld As DAO.Field
    Dim tbl As DAO.TableDef
    Set db = CurrentDb
    Set tbl = db.TableDefs("TAB_Inport_Exc")

Vu la doc sur les TableDefs on doit créer la tableDef par du code avec l'énumération de tous les champs, ma question : n'y a t il pas une méthode plus simple pour associer une table existante dans une base Access à un TableDef ?
Car si je veux associer ma table Import avec 26 champs ça m'arrangerait pas mal !
Merci encore de ton aide .
A+

**hyperion13** · 19/02/2023, 12h06

Salut @xeron33
tu indiques avoir lié ta feuille de calculs Excel à ta bdd.
pourquoi vouloir utiliser la collection TableDefs ? Créer une tbl temporaire ?
en l'état avec la tbl liée tu peux créer à partir de cette tbl des req, etc.

**deedolith** · 20/02/2023, 01h39

A partir du moment où tu lies une feuille Excel, une table est crée automatiquement.
Pourquoi vouloir en créer une autre (de la façon la plus laborieuse possible qui plus est) ?

Un exemple si tu veux contrôler le nom des colonnes:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
Dim Db As DAO.Database
Set Db = currentDb
 
Dim Tdf As DAO.TableDef
Set Tdf = Db.TableDefs("MaTable")
 
Dim Fld As DAO.Field
For Each Fld In Tdf.Fields
    If(Tdf.Name <> BonneValeur) Then
        MsgBox "Nom de colonne incorrecte: " & Tdf.Name
    End If
Next

Mais avant de t"attaquer à ca, tu as d'autres soucis à régler (le gros pavé que j'ai indiqué au début de mon poste précédent).

**xeron33** · 13/07/2023, 15h10

Envoyé par hyperion13

Salut @xeron33
tu indiques avoir lié ta feuille de calculs Excel à ta bdd.
pourquoi vouloir utiliser la collection TableDefs ? Créer une tbl temporaire ?
en l'état avec la tbl liée tu peux créer à partir de cette tbl des req, etc.

************************************************************************
De retour sur le sujet après plusieurs mois car la nouvelle procédure a été longue à écrire et je ne fais ça par sur du 100%...
MErci pour vos réponses à tous, je réponds plus particulièrement à hyperion car ce que j'ai fais correspond à ses questions.
J'ai donc créé une table liée et j'ai reécris toute le processus comme ceci, tout marche bien maintenant :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
Public Sub Import() ' Import Automatique
    MsgBox "Import Automatique"
    Dim db As Database
    Dim Rst  As DAO.Recordset
    Dim cpt As Integer
    Dim source As String
    Dim fld As DAO.Field
    Dim tbl As DAO.TableDef
    Set db = CurrentDb
    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
    On Error GoTo Ges_Err
    DoCmd.SetWarnings False
    csql2 = "delete * from Tab_Import;"
    DoCmd.RunSQL csql2
 
' Copie de la table liée TAB_Import_Exc vers Tab_Import
    DoCmd.OpenQuery "R_Import_Exc", , acReadOnly
'Fin de la copie
    source = "SELECT * from TAB_Import;"
    Set Rst = db.OpenRecordset(source)
    Debug.Print "nbr "; Rst.RecordCount
    Debug.Print "nbr 1 "; Rst.RecordCount
 
' Match_Insertions
      Rst.MoveFirst
      While Not Rst.EOF
         If Not IsNull(Rst("Emplacement")) Or Not IsNull(Rst("NUM_Archives")) Then              'Emplacement dossier et N° Dossier
           Match_Insertions Rst("Emplacement"), Rst("NUM_Archives")                 'Permet de voir si sur ce Dossier de voir s'il existe une Insertion
         End If                                                  'Si oui met à jour Date_Trait sur la table Insertion
                                                           'à la date du jour
 
        Rst.MoveNext
      Wend
'FIN du Match_Insertions
 
 
 '  Gestion des caractères spéciaux guillemets pour le champ Commentaires et Infos Compl
       Set Rst = db.OpenRecordset(source)
       Dim NumDEM   As String
       Rst.MoveFirst
       While Not Rst.EOF
         If InStr(Rst("Comm"), """") <> 0 Then
           strCellModifiee = CStr(Rst("Comm"))
           strCellModifiee = Replace(strCellModifiee, """", " ")
           NumDEM = CStr(Rst("NUM_DEMANDE"))
              cSQL = "Update [TAB_Import] "
              cSQL = cSQL & "Set [TAB_Import].[Comm]= '" & strCellModifiee & "'" & " where TAB_IMPORT.NUM_DEMANDE =  '" & NumDEM & "'"
              cSQL = cSQL & " ;"
           DoCmd.RunSQL cSQL
        End If
          Rst.MoveNext
        Wend
        Rst.MoveFirst
        While Not Rst.EOF
           If InStr(Rst("Infos_Compl"), """") <> 0 Then
           strCellModifiee = CStr(Rst("Infos_Compl"))
           strCellModifiee = Replace(strCellModifiee, """", " ")
           NumDEM = CStr(Rst("NUM_DEMANDE"))
              cSQL = "Update [TAB_Import] "
              cSQL = cSQL & "Set [TAB_Import].[Infos_Compl]= '" & strCellModifiee & "'" & " where TAB_IMPORT.NUM_DEMANDE =  '" & NumDEM & "'"
              cSQL = cSQL & " ;"
           DoCmd.RunSQL cSQL
        End If
          Rst.MoveNext
       Wend
' Fin  Gestion des caractères spéciaux guillemets pour les champs Commentaires et Infos Compl
 
  'Mise à jour si besoin du champ BonRechLong
      ' si les champs Commentaires et Infos Compl sont trop longs
       Set Rst = db.OpenRecordset(source)
       'Champ Commentaires
       Rst.MoveFirst
       While Not Rst.EOF
         strCellModifiee = CStr(Rst("Comm"))
         NumDEM = CStr(Rst("NUM_DEMANDE"))
         If Len(strCellModifiee) > 224 Then 'Commentaires
            cSQL22 = "UPDATE [TAB_IMPORT] Set [TAB_IMPORT].[BonRechLong]= 1 "
            cSQL22 = cSQL22 & "where [Tab_Import].[NUM_DEMANDE] = '" & NumDEM & "'"
            DoCmd.RunSQL cSQL22
         End If
         Rst.MoveNext
       Wend
       Set Rst = db.OpenRecordset(source)
       'Champ Infos Compl
       Rst.MoveFirst
       While Not Rst.EOF
         strCellModifiee = CStr(Rst("Infos_Compl"))
         NumDEM = CStr(Rst("NUM_DEMANDE"))
        If Len(strCellModifiee) > 123 Then  'NONREF
           cSQL22 = "UPDATE [TAB_IMPORT] Set [TAB_IMPORT].[BonRechLong]= 1 "
           cSQL22 = cSQL22 & "where [Tab_Import].[NUM_DEMANDE] = '" & NumDEM & "'"
           DoCmd.RunSQL cSQL22
         End If
         Rst.MoveNext
       Wend
 
        'Fin Mise à jour si besoin du champ BonRechLong
 
 
        'Code 128
         Set Rst = db.OpenRecordset(source)
         Rst.MoveFirst
         While Not Rst.EOF
            strCellModifiee = CStr(Rst("NUM_DEMANDE"))
            NumDEM = CStr(Rst("NUM_DEMANDE"))
            cSQL22 = "UPDATE [TAB_IMPORT] Set [TAB_IMPORT].[Num128]='" & Replace(Code128$(strCellModifiee), "'", "''") & "'" & ""
            cSQL22 = cSQL22 & "where Tab_Import.Num_Demande='" & Replace(NumDEM, "'", "''") & "'" & ";"
            DoCmd.RunSQL cSQL22
            Rst.MoveNext
         Wend
        'Fin Code 128
 
 
    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
    MsgBox ("Importation terminée ")
    'Edition Détail des Demandes
    'Suppression de toutes les données TAB_COUNT_UG2
    csql2 = "delete * from TAB_COUNT_UG2;"
    DoCmd.RunSQL csql2
 
    '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
 
    'EVERIAL
    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 = 'EVERIAL.EVERIAL' "
    c3SQL4 = c3SQL4 & "group by TAB_IMPORT2.UG_DEST"
    c3SQL4 = c3SQL4 & ";"
    DoCmd.RunSQL c3SQL4
 
    cSQL444 = "update [TAB_IMPORT2] "
    cSQL444 = cSQL444 & "set[TAB_IMPORT2].[SALLE]= 'EVERIAL' where TAB_IMPORT2.EMPLACEMENT = 'EVERIAL.EVERIAL' "
    cSQL444 = cSQL444 & ";"
    DoCmd.RunSQL cSQL444
 
    cSQL4444 = "update [TAB_COUNT_UG2] "
    cSQL4444 = cSQL4444 & "set[TAB_COUNT_UG2].[SALLE]= 'EVERIAL' "
    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]= 'EVERIAL' ;"
    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 LIKE 'BCA.TRANSFERT*' "
    c3SQL4 = c3SQL4 & "group by TAB_IMPORT2.UG_DEST"
    c3SQL4 = c3SQL4 & ";"
    DoCmd.RunSQL c3SQL4
 
    cSQL444 = "update [TAB_IMPORT2] "
    cSQL444 = cSQL444 & "set[TAB_IMPORT2].[SALLE]= 'TRANSFERTS' where TAB_IMPORT2.EMPLACEMENT LIKE 'BCA.TRANSFERT*' "
    cSQL444 = cSQL444 & ";"
    DoCmd.RunSQL cSQL444
 
    cSQL4444 = "update [TAB_COUNT_UG2] "
    cSQL4444 = cSQL4444 & "set [TAB_COUNT_UG2].[SALLE] = '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] = 'TRANSFERTS' ;"
    DoCmd.RunSQL cSQL4445
    DoCmd.Requery
    Call EditerDetDem 'Edition Détail des Demandes
FinGes_err:
  Exit Sub
Ges_Err:
  If err.Number = 3340 Then
     Resume Next
   Else
     MsgBox err.Description
     Resume Next
  End If
End Sub

Merci à tous donc, pour moi le sujet est résolu, toutefois si vous avez des commentaires ou questions n'hésitez pas.
A+

Gerer processus Excel depuis Access

VBA Access

Discussions similaires

Partager

Partager