Export de Access vers Excel

**k.p-j** · 09/05/2012, 19h28

Bonjour,
je suis actuellement en stage et je sent que ça ne va pas être très beau mais cependant je me bat .
J'ai un export a faire , j'ai essayé SQL les requêtes access mais la base a été mal faite à la base du coup la dernière solution est celle que je vous présente .
Cependant j'essaye de créer une feuille exel et je n'y arrive pas . Le traitement me parait juste mais j'aimerai savoir si vous pourriez y jeter un coup d’œil pour que ma feuille exel se crée et reçoive les données de mon record-set. Merci

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
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
Option Compare Database
Option Explicit
 
Sub exportprexp()
 Dim xlApp As Excel.Application
    Dim xlSheet As Excel.Worksheet
    Dim xlBook As Excel.Workbook
Dim strchemin As String
Dim SQL As String
Dim dbrage As Database
Dim dtetitac_precedent As Date
 
 
'chemin
strchemin = CurrentProject.Path
strchemin = strchemin + "\" & Year(Now) & Month(Now) & Day(Now) & "préexp.xls"
 
' Initialiser les variables
    Set xlApp = CreateObject("Excel.Application")
    Set xlBook = xlApp.Workbooks.Open(strchemin)
' Ajouter une feuille de calcul nommée preexp
    Set xlSheet = xlBook.Worksheets.Add
    xlSheet.Name = "preexp"
 
'Declaration de la requette
 SQL = "SELECT DISTINCTROW PATIENT.idpat, PATIENT.nom, PATIENT.prenom, TITAC.idtitac, TITAC.dtetitac, TITAC.titreac, TITAC.typetit, PATIENT.sexepat, PATIENT.prof, PATIENT.dtenaiss, SUIVI_PREEX.id_preex, CONSULT.idcslt, CONSULT.dtecslt, CONSULT.lieucs, CONSULT.nbdoses, CONSULT.numlot, CONSULT.nomvcc, CONSULT.typevcc, CONSULT.locale, CONSULT.locoreg, CONSULT.gene, CONSULT.rmqcs, ACAR.id_acar, ACAR.date_acar FROM (((PATIENT LEFT JOIN SUIVI_PREEX ON PATIENT.idpat=SUIVI_PREEX.idpat) LEFT JOIN CONSULT ON SUIVI_PREEX.id_preex=CONSULT.idpree) LEFT JOIN TITAC ON SUIVI_PREEX.id_preex=TITAC.idpreex) LEFT JOIN ACAR ON PATIENT.idpat=ACAR.id_patient WHERE (((Year(ACAR.date_acar))=2011)) Or (((Year(CONSULT.dtecslt))=2011)) Or (((Year(TITAC.dtetitac))=2011));"
 
'création du jeu de donnée
 Set dbrage = CurrentDb
Dim rst As DAO.Recordset
Set rst = dbrage.OpenRecordset(SQL)
 
 
    'declaration des variables
Dim col As Integer
Dim ligne As Integer
Dim colMax As Integer
Dim idpreex_precedent As Integer
Dim coltitac As Integer
idpreex_precedent = 0
  'Structure du tableau et ajout des titres sur la première ligne
  col = 1
  ligne = 1
 
   xlSheet.Cells(ligne, col).Value = "idpreex" '1
    col = col + 1
   xlSheet.Cells(ligne, col).Value = "idpat" '2
    col = col + 1
   xlSheet.Cells(ligne, col).Value = "nom" '3
    col = col + 1
   xlSheet.Cells(ligne, col).Value = "prenom" '4
    col = col + 1
   xlSheet.Cells(ligne, col).Value = "dtenaiss" '5
    col = col + 1
   xlSheet.Cells(ligne, col).Value = "sexe" '6
    col = col + 1
   xlSheet.Cells(ligne, col).Value = "prof" '7
    col = col + 1
 
    'chaque type de vaccin (contrainte de la base )
   xlSheet.Cells(ligne, col).Value = "dtecslt A1" '8
    col = col + 1
   xlSheet.Cells(ligne, col).Value = "dtecslt A5" '9
    col = col + 1
   xlSheet.Cells(ligne, col).Value = "dtecslt J01i" '10
    col = col + 1
   xlSheet.Cells(ligne, col).Value = "dtecslt J02i" '11
    col = col + 1
   xlSheet.Cells(ligne, col).Value = "dtecslt J21" '12
    col = col + 1
   xlSheet.Cells(ligne, col).Value = "dtecslt J30" '13
    col = col + 1
   xlSheet.Cells(ligne, col).Value = "dtecslt J7" '14
    col = col + 1
   xlSheet.Cells(ligne, col).Value = "dtecslt Non venu" '15
    col = col + 1
   xlSheet.Cells(ligne, col).Value = "dtecslt NV" '16
    col = col + 1
   xlSheet.Cells(ligne, col).Value = "dtecslt R1" '17
    col = col + 1
   xlSheet.Cells(ligne, col).Value = "dtecslt RA" '18
    col = col + 1
   xlSheet.Cells(ligne, col).Value = "dtecslt rappel" '19
    col = col + 1
 
    '(idem pour le lieu de vaccination )
   xlSheet.Cells(ligne, col).Value = "lieucs A1" '20
    col = col + 1
    xlSheet.Cells(ligne, col).Value = "lieucs A5" '21
    col = col + 1
    xlSheet.Cells(ligne, col).Value = "lieucs J01i" '22
    col = col + 1
    xlSheet.Cells(ligne, col).Value = "lieucs J02i" '23
    col = col + 1
    xlSheet.Cells(ligne, col).Value = "lieucs J21" '24
    col = col + 1
    xlSheet.Cells(ligne, col).Value = "lieucs J30" '24
    col = col + 1
    xlSheet.Cells(ligne, col).Value = "lieucs J7" '25
    col = col + 1
    xlSheet.Cells(ligne, col).Value = "lieucs Non venu" '26
    col = col + 1
    xlSheet.Cells(ligne, col).Value = "lieucs NV" '27
    col = col + 1
    xlSheet.Cells(ligne, col).Value = "lieucs R1" '28
    col = col + 1
    xlSheet.Cells(ligne, col).Value = "lieucs RA" '29
    col = col + 1
    xlSheet.Cells(ligne, col).Value = "lieucs rappel" '30
    col = col + 1
 
 
    '(idem nbdose)
   xlSheet.Cells(ligne, col).Value = "nbdoses A1" '31
    col = col + 1
    xlSheet.Cells(ligne, col).Value = "nbdoses A5" '32
    col = col + 1
    xlSheet.Cells(ligne, col).Value = "nbdoses J01i" '33
    col = col + 1
    xlSheet.Cells(ligne, col).Value = "nbdoses J02i" '34
    col = col + 1
    xlSheet.Cells(ligne, col).Value = "nbdoses J21" '35
    col = col + 1
    xlSheet.Cells(ligne, col).Value = "nbdoses J30" '36
    col = col + 1
    xlSheet.Cells(ligne, col).Value = "nbdoses J7" '37
    col = col + 1
    xlSheet.Cells(ligne, col).Value = "nbdoses Non venu" '38
    col = col + 1
    xlSheet.Cells(ligne, col).Value = "nbdoses NV" '39
    col = col + 1
    xlSheet.Cells(ligne, col).Value = "nbdoses R1" '40
    col = col + 1
    xlSheet.Cells(ligne, col).Value = "nbdoses RA" '41
    col = col + 1
    xlSheet.Cells(ligne, col).Value = "nbdoses rappel" '42
    col = col + 1
 
    '(idem numlot)->voir si vraiment utile
   xlSheet.Cells(ligne, col).Value = "numlot A1" '43
    col = col + 1
       xlSheet.Cells(ligne, col).Value = "numlot A5" '44
    col = col + 1
       xlSheet.Cells(ligne, col).Value = "numlot J01i" '45
    col = col + 1
       xlSheet.Cells(ligne, col).Value = "numlot J02i" '46
    col = col + 1
       xlSheet.Cells(ligne, col).Value = "numlot J21" '47
    col = col + 1
       xlSheet.Cells(ligne, col).Value = "numlot J30" '48
    col = col + 1
       xlSheet.Cells(ligne, col).Value = "numlot J7" '49
    col = col + 1
       xlSheet.Cells(ligne, col).Value = "numlot Non venu" '50
    col = col + 1
       xlSheet.Cells(ligne, col).Value = "numlot NV" '51
    col = col + 1
       xlSheet.Cells(ligne, col).Value = "numlot R1" '52
    col = col + 1
       xlSheet.Cells(ligne, col).Value = "numlot RA" '53
    col = col + 1
       xlSheet.Cells(ligne, col).Value = "numlot rappel" '54
    col = col + 1
   xlSheet.Cells(ligne, col).Value = "nomvcc" '55
    col = col + 1
 
   '(idem pour chacunes des reaction)
   xlSheet.Cells(ligne, col).Value = "locale A1" '56
    col = col + 1
   xlSheet.Cells(ligne, col).Value = "locoreg A1" '57
    col = col + 1
   xlSheet.Cells(ligne, col).Value = "gene A1" '58
    col = col + 1
 
   xlSheet.Cells(ligne, col).Value = "locale A5" '59
    col = col + 1
   xlSheet.Cells(ligne, col).Value = "locoreg A5" '60
    col = col + 1
   xlSheet.Cells(ligne, col).Value = "gene A5" '61
    col = col + 1
 
   xlSheet.Cells(ligne, col).Value = "locale J01i" '62
    col = col + 1
   xlSheet.Cells(ligne, col).Value = "locoreg J01i" '63
    col = col + 1
   xlSheet.Cells(ligne, col).Value = "gene J01i" '64
    col = col + 1
 
   xlSheet.Cells(ligne, col).Value = "locale J02i" '65
    col = col + 1
   xlSheet.Cells(ligne, col).Value = "locoreg J02i" '66
    col = col + 1
   xlSheet.Cells(ligne, col).Value = "gene J02i" '67
    col = col + 1
 
   xlSheet.Cells(ligne, col).Value = "locale J21" '68
    col = col + 1
   xlSheet.Cells(ligne, col).Value = "locoreg J21" '69
    col = col + 1
   xlSheet.Cells(ligne, col).Value = "gene J21" '70
    col = col + 1
 
   xlSheet.Cells(ligne, col).Value = "locale J30" '71
    col = col + 1
   xlSheet.Cells(ligne, col).Value = "locoreg J30" '72
    col = col + 1
   xlSheet.Cells(ligne, col).Value = "gene J30" '73
    col = col + 1
 
   xlSheet.Cells(ligne, col).Value = "locale J7" '74
    col = col + 1
   xlSheet.Cells(ligne, col).Value = "locoreg J7" '75
    col = col + 1
   xlSheet.Cells(ligne, col).Value = "gene J7" '76
    col = col + 1
 
   xlSheet.Cells(ligne, col).Value = "locale Non venu" '77
    col = col + 1
   xlSheet.Cells(ligne, col).Value = "locoreg Non venu" '78
    col = col + 1
   xlSheet.Cells(ligne, col).Value = "gene Non venu" '79
    col = col + 1
 
   xlSheet.Cells(ligne, col).Value = "locale NV" '80
    col = col + 1
   xlSheet.Cells(ligne, col).Value = "locoreg NV" '81
    col = col + 1
   xlSheet.Cells(ligne, col).Value = "gene NV" '82
    col = col + 1
 
   xlSheet.Cells(ligne, col).Value = "locale R1" '83
    col = col + 1
   xlSheet.Cells(ligne, col).Value = "locoreg R1" '84
    col = col + 1
   xlSheet.Cells(ligne, col).Value = "gene R1" '85
    col = col + 1
 
   xlSheet.Cells(ligne, col).Value = "locale RA" '86
    col = col + 1
   xlSheet.Cells(ligne, col).Value = "locoreg RA" '87
    col = col + 1
   xlSheet.Cells(ligne, col).Value = "gene RA" '88
    col = col + 1
 
   xlSheet.Cells(ligne, col).Value = "locale numlot rappel" '89
    col = col + 1
   xlSheet.Cells(ligne, col).Value = "locoreg numlot rappel" '90
    col = col + 1
   xlSheet.Cells(ligne, col).Value = "gene numlot rappel" '91
    col = col + 1
 
    'Il faut aussi prevoir 5 colone pour les titrage " dte 1 tit1 ect .".)
   xlSheet.Cells(ligne, col).Value = "dtetitac 1" '92
    col = col + 1
   xlSheet.Cells(ligne, col).Value = "titreac 1" '93
    col = col + 1
   xlSheet.Cells(ligne, col).Value = "typetit 1" '94
    col = col + 1
 
    xlSheet.Cells(ligne, col).Value = "dtetitac 2" '95
    col = col + 1
   xlSheet.Cells(ligne, col).Value = "titreac 2" '96
    col = col + 1
   xlSheet.Cells(ligne, col).Value = "typetit 2" '97
    col = col + 1
 
    xlSheet.Cells(ligne, col).Value = "dtetitac 3" '98
    col = col + 1
   xlSheet.Cells(ligne, col).Value = "titreac 3" '99
    col = col + 1
   xlSheet.Cells(ligne, col).Value = "typetit 3" '100
    col = col + 1
 
    xlSheet.Cells(ligne, col).Value = "dtetitac 4" '101
    col = col + 1
   xlSheet.Cells(ligne, col).Value = "titreac 4" '102
    col = col + 1
   xlSheet.Cells(ligne, col).Value = "typetit 4" '103
    col = col + 1
 
    xlSheet.Cells(ligne, col).Value = "dtetitac 5" '104
    col = col + 1
   xlSheet.Cells(ligne, col).Value = "titreac 5" '105
    col = col + 1
   xlSheet.Cells(ligne, col).Value = "typetit 5" '106
    col = col + 1
 
    xlSheet.Cells(ligne, col).Value = "dtetitac 6" '107
    col = col + 1
   xlSheet.Cells(ligne, col).Value = "titreac 6" '108
    col = col + 1
   xlSheet.Cells(ligne, col).Value = "typetit 6" '109
    col = col + 1
 
    '(il faudras ajouter un test pour ne recuperer que les dates acar de 20011)
   xlSheet.Cells(ligne, col).Value = "date_acar" '110
    ligne = 1
    colMax = col
    col = 0
    'Parcours le jeu d'enregistrement jusqu'à la fin
While Not rst.EOF
 
If rst![idpreex].Value <> idpreex_precedent Then
ligne = ligne + 1
'remplissage
xlSheet.Cells(ligne, 1) = rst![idpreex]
xlSheet.Cells(ligne, 2) = rst![idpat]
xlSheet.Cells(ligne, 3) = rst![nom]
xlSheet.Cells(ligne, 4) = rst![prenom]
xlSheet.Cells(ligne, 5) = rst![dtenaiss]
xlSheet.Cells(ligne, 6) = rst![sexe]
xlSheet.Cells(ligne, 7) = rst![prof]
xlSheet.Cells(ligne, 92).Value = rst![dtetitac] '92
xlSheet.Cells(ligne, 93).Value = rst![titreac] '93
xlSheet.Cells(ligne, 94).Value = rst![typetit] '94
dtetitac_precedent = rst![dtetitac]
coltitac = 92
 'boucle qui ne recupere que les date acar de l'année concernée
 If Year(rst![date_acar]) = 2011 Then xlSheet.Cells(ligne, col + 1) = rst![date_acar]
 
 
  Select Case rst![typevcc].Value
    Case Is = "A1"
   xlSheet.Cells(ligne, 8) = rst![dtecslt]  '8
   xlSheet.Cells(ligne, 20) = rst![lieucs]  '20
   xlSheet.Cells(ligne, 31) = rst![nbdoses] '31
   xlSheet.Cells(ligne, 43) = rst![numlot] '43
   xlSheet.Cells(ligne, 56) = rst![locale] '56
   xlSheet.Cells(ligne, 57) = rst![locoreg] '57
   xlSheet.Cells(ligne, 58) = rst![gene] '58
 
 
    Case Is = "A5"
   xlSheet.Cells(ligne, 9) = rst![dtecslt] '9
   xlSheet.Cells(ligne, 21) = rst![lieucs]  '21
   xlSheet.Cells(ligne, 32) = rst![nbdoses]  '32
   xlSheet.Cells(ligne, 44) = rst![numlot]  '44
   xlSheet.Cells(ligne, 59) = rst![locale]  '59
   xlSheet.Cells(ligne, 60) = rst![locoreg] '60
   xlSheet.Cells(ligne, 61) = rst![gene] '61
 
    Case Is = "j01i"
   xlSheet.Cells(ligne, 10) = rst![dtecslt] '10
   xlSheet.Cells(ligne, 22) = rst![lieucs] '22
   xlSheet.Cells(ligne, 33) = rst![nbdoses] '33
   xlSheet.Cells(ligne, 45) = rst![numlot] '45
   xlSheet.Cells(ligne, 62) = rst![locale] '62
   xlSheet.Cells(ligne, 63) = rst![locoreg] '63
   xlSheet.Cells(ligne, 64) = rst![gene] '64
 
    Case Is = "j02i"
   xlSheet.Cells(ligne, 11) = rst![dtecslt] '11
   xlSheet.Cells(ligne, 23) = rst![lieucs] '23
   xlSheet.Cells(ligne, 34) = rst![nbdoses] '34
   xlSheet.Cells(ligne, 46) = rst![numlot] '46
   xlSheet.Cells(ligne, 65) = rst![locale] '65
   xlSheet.Cells(ligne, 66) = rst![locoreg] '66
   xlSheet.Cells(ligne, 67) = rst![gene] '67
 
    Case Is = "j21"
   xlSheet.Cells(ligne, 12) = rst![dtecslt] '12
   xlSheet.Cells(ligne, 24) = rst![lieucs] '24
   xlSheet.Cells(ligne, 35) = rst![nbdoses] '35
   xlSheet.Cells(ligne, 47) = rst![numlot] '47
   xlSheet.Cells(ligne, 68) = rst![locale] '68
   xlSheet.Cells(ligne, 69) = rst![locoreg] '69
   xlSheet.Cells(ligne, 70) = rst![gene] '70
 
    Case Is = "j30"
   xlSheet.Cells(ligne, 13) = rst![dtecslt] '13
   xlSheet.Cells(ligne, 24) = rst![lieucs] '24
   xlSheet.Cells(ligne, 36) = rst![nbdoses] '36
   xlSheet.Cells(ligne, 48) = rst![numlot] '48
   xlSheet.Cells(ligne, 71) = rst![locale] '71
   xlSheet.Cells(ligne, 72) = rst![locoreg] '72
   xlSheet.Cells(ligne, 73) = rst![gene] '73
 
    Case Is = "j7"
   xlSheet.Cells(ligne, 14) = rst![dtecslt] '14
   xlSheet.Cells(ligne, 25) = rst![lieucs] '25
   xlSheet.Cells(ligne, 37) = rst![nbdoses] '37
   xlSheet.Cells(ligne, 49) = rst![numlot] '49
   xlSheet.Cells(ligne, 74) = rst![locale] '74
   xlSheet.Cells(ligne, 75) = rst![locoreg] '75
   xlSheet.Cells(ligne, 76) = rst![gene] '76
 
    Case Is = "Non venu"
   xlSheet.Cells(ligne, 15) = rst![dtecslt] '15
   xlSheet.Cells(ligne, 26) = rst![lieucs] '26
   xlSheet.Cells(ligne, 38) = rst![nbdoses] '38
   xlSheet.Cells(ligne, 50) = rst![numlot] '50
   xlSheet.Cells(ligne, 77) = rst![locale] '77
   xlSheet.Cells(ligne, 78) = rst![locoreg] '78
   xlSheet.Cells(ligne, 79) = rst![gene] '79
 
    Case Is = "NV"
   xlSheet.Cells(ligne, 16) = rst![dtecslt] '16
   xlSheet.Cells(ligne, 27) = rst![lieucs] '27
   xlSheet.Cells(ligne, 39) = rst![nbdoses] '39
   xlSheet.Cells(ligne, 51) = rst![numlot] '51
   xlSheet.Cells(ligne, 80) = rst![locale] '80
   xlSheet.Cells(ligne, 81) = rst![locoreg] '81
   xlSheet.Cells(ligne, 82) = rst![gene] '82
 
    Case Is = "R1"
   xlSheet.Cells(ligne, 17) = rst![dtecslt] '17
   xlSheet.Cells(ligne, 28) = rst![lieucs] '28
   xlSheet.Cells(ligne, 40) = rst![nbdoses] '40
   xlSheet.Cells(ligne, 52) = rst![numlot] '52
   xlSheet.Cells(ligne, 83) = rst![locale] '83
   xlSheet.Cells(ligne, 84) = rst![locoreg] '84
   xlSheet.Cells(ligne, 85) = rst![gene] '85
 
    Case Is = "RA"
   xlSheet.Cells(ligne, 18) = rst![dtecslt] '18
   xlSheet.Cells(ligne, 29) = rst![lieucs] '29
   xlSheet.Cells(ligne, 41) = rst![nbdoses] '41
   xlSheet.Cells(ligne, 53) = rst![numlot] '53
   xlSheet.Cells(ligne, 86) = rst![locale] '86
   xlSheet.Cells(ligne, 87) = rst![locoreg] '87
   xlSheet.Cells(ligne, 88) = rst![gene] '88
 
      Case Is = "rappel"
       xlSheet.Cells(ligne, 19) = rst![dtecslt] '19
   xlSheet.Cells(ligne, 30) = rst![lieucs] '30
    xlSheet.Cells(ligne, 42) = rst![nbdoses] '42
   xlSheet.Cells(ligne, 54) = rst![numlot] '54
   xlSheet.Cells(ligne, 89) = rst![locale] '89
   xlSheet.Cells(ligne, 90) = rst![locoreg] '90
   xlSheet.Cells(ligne, 91) = rst![gene] '91
End Select
 
Else:
  Select Case rst![typevcc].Value
    Case Is = "A1"
   xlSheet.Cells(ligne, 8) = rst![dtecslt] '8
   xlSheet.Cells(ligne, 20) = rst![lieucs] '20
   xlSheet.Cells(ligne, 31) = rst![nbdoses] '31
   xlSheet.Cells(ligne, 43) = rst![numlot] '43
   xlSheet.Cells(ligne, 56) = rst![locale] '56
   xlSheet.Cells(ligne, 57) = rst![locoreg] '57
   xlSheet.Cells(ligne, 58) = rst![gene] '58
 
 
    Case Is = "A5"
   xlSheet.Cells(ligne, 9) = rst![dtecslt] '9
   xlSheet.Cells(ligne, 21) = rst![lieucs] '21
   xlSheet.Cells(ligne, 32) = rst![nbdoses] '32
   xlSheet.Cells(ligne, 44) = rst![numlot] '44
   xlSheet.Cells(ligne, 59) = rst![locale] '59
   xlSheet.Cells(ligne, 60) = rst![locoreg] '60
   xlSheet.Cells(ligne, 61) = rst![gene] '61
 
    Case Is = "j01i"
   xlSheet.Cells(ligne, 10) = rst![dtecslt] '10
   xlSheet.Cells(ligne, 22) = rst![lieucs] '22
   xlSheet.Cells(ligne, 33) = rst![nbdoses] '33
   xlSheet.Cells(ligne, 45) = rst![numlot] '45
   xlSheet.Cells(ligne, 62) = rst![locale] '62
   xlSheet.Cells(ligne, 63) = rst![locoreg] '63
   xlSheet.Cells(ligne, 64) = rst![gene] '64
 
    Case Is = "j02i"
   xlSheet.Cells(ligne, 11) = rst![dtecslt] '11
   xlSheet.Cells(ligne, 23) = rst![lieucs] '23
   xlSheet.Cells(ligne, 34) = rst![nbdoses] '34
   xlSheet.Cells(ligne, 46) = rst![numlot] '46
   xlSheet.Cells(ligne, 65) = rst![locale] '65
   xlSheet.Cells(ligne, 66) = rst![locoreg] '66
   xlSheet.Cells(ligne, 67) = rst![gene] '67
 
    Case Is = "j21"
   xlSheet.Cells(ligne, 12) = rst![dtecslt] '12
   xlSheet.Cells(ligne, 24) = rst![lieucs] '24
   xlSheet.Cells(ligne, 35) = rst![nbdoses] '35
   xlSheet.Cells(ligne, 47) = rst![numlot] '47
   xlSheet.Cells(ligne, 68) = rst![locale] '68
   xlSheet.Cells(ligne, 69) = rst![locoreg] '69
   xlSheet.Cells(ligne, 70) = rst![gene] '70
 
    Case Is = "j30"
   xlSheet.Cells(ligne, 13) = rst![dtecslt] '13
   xlSheet.Cells(ligne, 24) = rst![lieucs] '24
   xlSheet.Cells(ligne, 36) = rst![nbdoses] '36
   xlSheet.Cells(ligne, 48) = rst![numlot] '48
   xlSheet.Cells(ligne, 71) = rst![locale] '71
   xlSheet.Cells(ligne, 72) = rst![locoreg] '72
   xlSheet.Cells(ligne, 73) = rst![gene] '73
 
    Case Is = "j7"
   xlSheet.Cells(ligne, 14) = rst![dtecslt] '14
   xlSheet.Cells(ligne, 25) = rst![lieucs] '25
   xlSheet.Cells(ligne, 37) = rst![nbdoses] '37
   xlSheet.Cells(ligne, 49) = rst![numlot] '49
   xlSheet.Cells(ligne, 74) = rst![locale] '74
   xlSheet.Cells(ligne, 75) = rst![locoreg] '75
   xlSheet.Cells(ligne, 76) = rst![gene] '76
 
    Case Is = "Non venu"
   xlSheet.Cells(ligne, 15) = rst![dtecslt] '15
   xlSheet.Cells(ligne, 26) = rst![lieucs] '26
   xlSheet.Cells(ligne, 38) = rst![nbdoses] '38
   xlSheet.Cells(ligne, 50) = rst![numlot] '50
   xlSheet.Cells(ligne, 77) = rst![locale] '77
   xlSheet.Cells(ligne, 78) = rst![locoreg] '78
   xlSheet.Cells(ligne, 79) = rst![gene] '79
 
    Case Is = "NV"
   xlSheet.Cells(ligne, 16) = rst![dtecslt] '16
   xlSheet.Cells(ligne, 27) = rst![lieucs] '27
   xlSheet.Cells(ligne, 39) = rst![nbdoses] '39
   xlSheet.Cells(ligne, 51) = rst![numlot] '51
   xlSheet.Cells(ligne, 80) = rst![locale] '80
   xlSheet.Cells(ligne, 81) = rst![locoreg] '81
   xlSheet.Cells(ligne, 82) = rst![gene] '82
 
    Case Is = "R1"
   xlSheet.Cells(ligne, 17) = rst![dtecslt] '17
   xlSheet.Cells(ligne, 28) = rst![lieucs] '28
   xlSheet.Cells(ligne, 40) = rst![nbdoses] '40
   xlSheet.Cells(ligne, 52) = rst![numlot] '52
   xlSheet.Cells(ligne, 83) = rst![locale] '83
   xlSheet.Cells(ligne, 84) = rst![locoreg] '84
   xlSheet.Cells(ligne, 85) = rst![gene] '85
 
    Case Is = "RA"
   xlSheet.Cells(ligne, 18) = rst![dtecslt] '18
   xlSheet.Cells(ligne, 29) = rst![lieucs] '29
   xlSheet.Cells(ligne, 41) = rst![nbdoses] '41
   xlSheet.Cells(ligne, 53) = rst![numlot] '53
   xlSheet.Cells(ligne, 86) = rst![locale] '86
   xlSheet.Cells(ligne, 87) = rst![locoreg] '87
   xlSheet.Cells(ligne, 88) = rst![gene] '88
 
      Case Is = "rappel"
       xlSheet.Cells(ligne, 19) = rst![dtecslt] '19
   xlSheet.Cells(ligne, 30) = rst![lieucs] '30
    xlSheet.Cells(ligne, 42) = rst![nbdoses] '42
   xlSheet.Cells(ligne, 54) = rst![numlot] '54
   xlSheet.Cells(ligne, 89) = rst![locale] '89
   xlSheet.Cells(ligne, 90) = rst![locoreg] '90
   xlSheet.Cells(ligne, 91) = rst![gene] '91
End Select
    If dtetitac_precedent <> rst![dtetitac] Then
   xlSheet.Cells(ligne, coltitac + 2).Value = rst![dtetitac] '92
    coltitac = coltitac + 2
xlSheet.Cells(ligne, coltitac + 2).Value = rst![titreac] '93
coltitac = coltitac + 2
xlSheet.Cells(ligne, coltitac + 2).Value = rst![typetit] '94
coltitac = coltitac + 2
dtetitac_precedent = Null
End If
 
idpreex_precedent = rst![idpreex].Value
rst.MoveNext
End If
Wend
 
    ' Fermeture du Recordset
    rst.Close
 
End Sub

**marsouin_89** · 09/05/2012, 21h02

Bonsoir,

Ton code est assez compliqué et il est donc difficile d'en faire une expertise.

Cela dit, ne pourrais tu pas exporter ta requête directement en fichier Excel et ensuite faire les quelques modifs nécessaires.

Pour exporter ta requête en Excel, interresses toi à :

Code :

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

DoCmd.TransferSpreadsheet acExport, , "NomDeMaRequete", "CheminDuFichierExcel"

Cordialement

Christophe

**k.p-j** · 09/05/2012, 21h10

Envoyé par marsouin_89

Bonsoir,

Ton code est assez compliqué et il est donc difficile d'en faire une expertise.

Cela dit, ne pourrais tu pas exporter ta requête directement en fichier Excel et ensuite faire les quelques modifs nécessaires.

Pour exporter ta requête en Excel, interresses toi à :

Code :

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

DoCmd.TransferSpreadsheet acExport, , "NomDeMaRequete", "CheminDuFichierExcel"

Cordialement

Christophe

salut Christophe
J'ai déjà utilisé cette méthode et je suis réellement obligé de faire comme dans mon code car la base de donnée a été très mal réalisée . du coup je suis obligé de faire du cas par cas .

Pour être plus précis je me suis inspiré de cette méthode http://="http://access.developpez.co...el#PilotExcel"
mais quand je lance mon programme une erreur me dit que le chemin d'acces n'existe pas alors que je veux créer mon fichier .

Invité · 09/05/2012, 21h25

Bonjour

Envoyé par k.p-j

mais quand je lance mon programme une erreur me dit que le chemin d'acces n'existe pas alors que je veux créer mon fichier .

Tu ne pouvais pas le dire tout de suite, non ?

As-tu contrôlé ce qu'il y a dans ta variable chemin ? De plus n'utilises pas le + pour concaténer, le + c'est pour les opérations, utilise le symbole &.

Philippe

**k.p-j** · 09/05/2012, 21h30

Envoyé par Philippe JOCHMANS

Bonjour

Tu ne pouvais pas le dire tout de suite, non ?

As-tu contrôlé ce qu'il y a dans ta variable chemin ? De plus n'utilises pas le + pour concaténer, le + c'est pour les opérations, utilise le symbole &.

Philippe

oui oui tout est controlé

J'ai trouvé ce petit code qui aperement fonctionne mais je ne vois pas comment l'adapter .

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
Sub essaiexport()
     'Création d'un nouveau classeur excel
    Dim appEcxel As Excel.Application
    Dim wbkCommandes As Excel.Workbook
    Dim wksCommandes As Excel.Worksheet
 
    Set appEcxel = New Excel.Application
    Set wbkCommandes = appEcxel.Workbooks.Add
    Set wksCommandes = appEcxel.ActiveSheet
 
    feuilleExcel = CurrentProject.Path & "\" & Year(Now) & Month(Now) & Day(Now) & ".xlsx"
 
    wksCommandes.SaveAs (feuilleExcel)
    appEcxel.Visible = True
    wksCommandes.Visible = xlSheetVisible
 
 
End Sub

**marsouin_89** · 09/05/2012, 23h01

Bonsoir,

Tiens, voici quelques lignes d'un code que j'utilise.
A savoir que je ne suis pas un champion du monde pour ce type de manip, mais celui là devrait fonctionner.
Cependant, je ne suis pas sur que tu puisses exporter en format Office 2007 ou 2010. A confirmer.

Code :

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

1
2
'Appel du code
Call ExportExcel

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
Sub ExportExcel()
 
Dim xlApp As Excel.Application 'Est Excel
Dim xlBook  As Excel.Workbook 'Est un classeur
Dim xlWks  As Excel.Worksheet 'Est une feuille
Dim xlRange As Variant 'Est une cellule
Dim FichierXl As String 'Est le chemin du fichier de sortie
 
FichierXl = "LeCheminDeDestinationXls"
 
DoCmd.TransferSpreadsheet acExport, , "NomDeMaRequete", FichierXl
    'Export des données de la requête en fichier Excel. La fonction False pour ne pas avoir les entêtes de colonnes _
    ne fonctionne pas pour un export Excel.
 
Set xlApp = CreateObject("Excel.Application") 'Ouverture d'une nouvelle instance d'Excel
Set xlBook = xlApp.Workbooks.Open(FichierXl) 'Ouverture du fichier
Set xlWks = xlBook.ActiveSheet 'Activation de la feuille
Set xlRange = xlWks.Range("A1:A65535") 'Création de la plage de cellules. 65535 stations possible (limite du programme Excel)
 
'Par exemple
xlWks.Range("A2") = "UneValeurQuelconque"
 
'Ou pour la cellule C1
xlWks.Cells(1, 3) = "UnAutreValeurQuelconque"
 
'et quelques fonctions
xlWks.Cells(1, 3).Font.Size = 10 'Taille de police
xlWks.Cells(1, 3).Borders.Color = RGB(0, 0, 0) 'Style de trait pour la cellule
xlWks.Columns("A:AD").Font.Name = "Arial" 'Type de police utilisée
xlWks.Cells(1, 3).HorizontalAlignment = xlCenter 'Le texte est centré(Horizontal)
xlWks.Cells(1, 3).VerticalAlignment = xlCenter 'Le texte est centré (Vertical)
xlWks.Columns("A").Font.Bold = True 'Le texte de la 2° colonne est en gras
xlWks.Columns("C:D").NumberFormat = "00" 'Format de nombre des collones C et D à 2 chiffres
xlWks.Columns("A:O").EntireColumn.AutoFit 'Ajustement automatique de chaque colonne
xlWks.Range("A2:A1").Merge 'Fusionne les cellules A2 et A1
xlWks.Range("K1:O1").Interior.Color = RGB(221, 221, 221) 'Couleur gris à l'intérieur de la cellule
xlWks.Name = "NouveauNomDeLaFeuille" 'Renomme la feuille
xlApp.ActiveWindow.SplitRow = 2 'Fractionne les 2 premières colonnes
xlApp.ActiveWindow.FreezePanes = True 'Fige les 2 premières colonnes
 
 
xlApp.visible = False 'Excel est invisible
xlWks.Activate 'Activation de la feuille1
xlRange.Cells(1, 1).Select 'Selection de la cellule A1
xlApp.DisplayAlerts = False 'Le message d'enregistrement est désactivé
xlBook.Close True 'Fermer le fichier et l'enregistre sans message de confirmation dû à xlapp.DisplayAlerts=false
xlApp.Quit 'Fermerture d'excel
xlApp.DisplayAlerts = True 'Le message d'enregistrement est réactivé
 
Set xlRange = Nothing 'Effacement de la mémoire tampon de la cellule active
Set xlWks = Nothing  'Effacement de la mémoire tampon de la feuille active
Set xlBook = Nothing  'Effacement de la mémoire tampon du classeur actif
Set xlApp = Nothing  'Effacement de la mémoire tampon de l'instance Excel
 
End Sub

Cordialement

Christophe

Export de Access vers Excel

VBA Access

Vue hybride

Discussions similaires

Partager

Partager