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....