message erreur: Microsoft office excel attend la fin de l'exécution d'une action OLE d'une autre application.

**rob1son76** · 28/02/2012, 17h19

Bonjour,

J'ai un fichier excel en lecture seul qui récupère les données d'une base access.
J'ai 7 requêtes pour récupérer la totalité de mes données nécessaires.
Au début ca marchait bien et un jour j'ai eu le message d'erreur d'écrit dans le titre.

Je vous met mon code 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
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
Dim db As DAO.Database
Dim rq As DAO.QueryDef
Dim rq1 As DAO.QueryDef
Dim rq2 As DAO.QueryDef
Dim rq3 As DAO.QueryDef
Dim rq4 As DAO.QueryDef
Dim rq5 As DAO.QueryDef
Dim rq6 As DAO.QueryDef
Dim rq7 As DAO.QueryDef
Dim rs As DAO.Recordset
Dim rs1 As DAO.Recordset
Dim rs2 As DAO.Recordset
Dim rs3 As DAO.Recordset
Dim rs4 As DAO.Recordset
Dim rs5 As DAO.Recordset
Dim rs6 As DAO.Recordset
Dim rs7 As DAO.Recordset
Dim i As Integer
 
'rq est la requête Rqt_Fiche_Projet_Caractéristique, rs son recordset
'rq1 est la requête Rqt_Fiche_Projet, rs1 son recordset
'rq2 est la requête Rqt_Fiche_Projet_NO, rs2 son recordset
 
Worksheets("Data").Activate
nbli = Range("CK65536").End(xlUp).Row
 
    For i = 2 To nbli
        For j = 1 To 260
        Worksheets("Data").Cells([i], [j]).Value = ""
        Next
    Next
 
nbli2 = Range("EZ65536").End(xlUp).Row
 
    For i = 2 To nbli2
        For j = 1 To 260
        Worksheets("Data").Cells([i], [j]).Value = ""
        Next
    Next
 
'connexion à la bdd et à la requête
Set db = DBEngine.OpenDatabase("C...")
 
Set rq = db.QueryDefs("Rqt_Fiche_Projet_Caractéristique")
Set rs = rq.OpenRecordset
 
Range("A2").Select
Do While Not rs.EOF  'Répéter tant qu'on est pas à la fin
ActiveCell.Value = rs.Fields(1) 'on écrit le contenu du champ 1
ActiveCell.Offset(0, 1).Value = rs.Fields(3) 'à droite celui du champ 2
ActiveCell.Offset(0, 2).Value = rs.Fields(4) '2 colonne à droite celui du champ 3
ActiveCell.Offset(0, 3).Value = rs.Fields(6)
ActiveCell.Offset(0, 4).Value = rs.Fields(7)
ActiveCell.Offset(0, 5).Value = rs.Fields(8)
ActiveCell.Offset(0, 6).Value = rs.Fields(9)
ActiveCell.Offset(0, 7).Value = rs.Fields(10)
ActiveCell.Offset(0, 8).Value = rs.Fields(11)
ActiveCell.Offset(0, 9).Value = rs.Fields(12)
ActiveCell.Offset(0, 10).Value = rs.Fields(13)
ActiveCell.Offset(0, 11).Value = rs.Fields(14)
ActiveCell.Offset(0, 12).Value = rs.Fields(16)
ActiveCell.Offset(0, 13).Value = rs.Fields(18)
ActiveCell.Offset(0, 14).Value = rs.Fields(20)
ActiveCell.Offset(0, 15).Value = rs.Fields(21)
ActiveCell.Offset(0, 16).Value = rs.Fields(22)
ActiveCell.Offset(0, 17).Value = rs.Fields(23)
ActiveCell.Offset(0, 18).Value = rs.Fields(24)
ActiveCell.Offset(0, 19).Value = rs.Fields(25)
ActiveCell.Offset(0, 20).Value = rs.Fields(26)
 
ActiveCell.Offset(1).Select 'lorqu'on a ecrit tout on descend
rs.MoveNext 'on passe à l'enreg suivant (access)
 
Loop
 
rs.Close
rq.Close
Set rs = Nothing
Set rq = Nothing
 
Set rq1 = db.QueryDefs("Rqt_Data_Regroupe_1")
Set rs1 = rq1.OpenRecordset
 
    Range("A2").Select
    Do While Not rs1.EOF  'Répéter tant qu'on est pas à la fin
    ActiveCell.Offset(0, 22).Value = rs1.Fields(0) 'on écrit le contenu du champ 1
    ActiveCell.Offset(0, 23).Value = rs1.Fields(1) 'à droite celui du champ 2
    ActiveCell.Offset(0, 24).Value = rs1.Fields(2) '2 colonne à droite celui du champ 3
    ActiveCell.Offset(0, 25).Value = rs1.Fields(3)
    ActiveCell.Offset(0, 26).Value = rs1.Fields(4)
    ActiveCell.Offset(0, 27).Value = rs1.Fields(5)
    ActiveCell.Offset(0, 28).Value = rs1.Fields(6)
    ActiveCell.Offset(0, 29).Value = rs1.Fields(7)
    ActiveCell.Offset(0, 30).Value = rs1.Fields(8)
    ActiveCell.Offset(0, 31).Value = rs1.Fields(9)
    ActiveCell.Offset(0, 32).Value = rs1.Fields(10)
    ActiveCell.Offset(0, 33).Value = rs1.Fields(11)
    ActiveCell.Offset(0, 34).Value = rs1.Fields(12)
    ActiveCell.Offset(0, 35).Value = rs1.Fields(13)
    ActiveCell.Offset(0, 36).Value = rs1.Fields(14)
    ActiveCell.Offset(0, 37).Value = rs1.Fields(15)
    ActiveCell.Offset(0, 38).Value = rs1.Fields(16)
    ActiveCell.Offset(0, 39).Value = rs1.Fields(17)
    ActiveCell.Offset(0, 40).Value = rs1.Fields(18)
    ActiveCell.Offset(0, 41).Value = rs1.Fields(19)
    ActiveCell.Offset(0, 42).Value = rs1.Fields(20)
    ActiveCell.Offset(0, 43).Value = rs1.Fields(21)
    ActiveCell.Offset(0, 44).Value = rs1.Fields(22)
    ActiveCell.Offset(0, 45).Value = rs1.Fields(23)
    ActiveCell.Offset(0, 46).Value = rs1.Fields(24)
    ActiveCell.Offset(0, 47).Value = rs1.Fields(25)
    ActiveCell.Offset(0, 48).Value = rs1.Fields(26)
    ActiveCell.Offset(0, 49).Value = rs1.Fields(27)
    ActiveCell.Offset(0, 50).Value = rs1.Fields(28)
    ActiveCell.Offset(0, 51).Value = rs1.Fields(29)
    ActiveCell.Offset(0, 52).Value = rs1.Fields(30)
    ActiveCell.Offset(0, 53).Value = rs1.Fields(31)
    ActiveCell.Offset(0, 54).Value = rs1.Fields(32)
    ActiveCell.Offset(0, 55).Value = rs1.Fields(33)
    ActiveCell.Offset(0, 56).Value = rs1.Fields(34)
    ActiveCell.Offset(0, 57).Value = rs1.Fields(35)
    ActiveCell.Offset(0, 58).Value = rs1.Fields(36)
    ActiveCell.Offset(0, 59).Value = rs1.Fields(37)
    ActiveCell.Offset(0, 60).Value = rs1.Fields(38)
    ActiveCell.Offset(0, 61).Value = rs1.Fields(39)
    ActiveCell.Offset(0, 62).Value = rs1.Fields(40)
    ActiveCell.Offset(0, 63).Value = rs1.Fields(41)
    ActiveCell.Offset(0, 64).Value = rs1.Fields(42)
    ActiveCell.Offset(0, 65).Value = rs1.Fields(43)
    ActiveCell.Offset(0, 66).Value = rs1.Fields(44)
    ActiveCell.Offset(0, 67).Value = rs1.Fields(45)
    ActiveCell.Offset(0, 68).Value = rs1.Fields(46)
    ActiveCell.Offset(0, 69).Value = rs1.Fields(47)
    ActiveCell.Offset(0, 70).Value = rs1.Fields(48)
    ActiveCell.Offset(0, 71).Value = rs1.Fields(49)
    ActiveCell.Offset(0, 72).Value = rs1.Fields(50)
    ActiveCell.Offset(0, 85).Value = rs1.Fields(51)
    ActiveCell.Offset(0, 86).Value = rs1.Fields(52)
 
    ActiveCell.Offset(1).Select 'lorqu'on a ecrit tout on descend
    rs1.MoveNext 'on passe à l'enreg suivant (access)
    Loop
 
rs1.Close
rq1.Close
Set rs1 = Nothing
Set rq1 = Nothing
 
Set rq2 = db.QueryDefs("Rqt_Data_Regroupe_2")
Set rs2 = rq2.OpenRecordset
 
    Range("A2").Select
    Do While Not rs2.EOF  'Répéter tant qu'on est pas à la fin
    ActiveCell.Offset(0, 73).Value = rs2.Fields(3) 'on écrit le contenu du champ 1
    ActiveCell.Offset(0, 140).Value = rs2.Fields(3)
    ActiveCell.Offset(0, 74).Value = rs2.Fields(4) 'à droite celui du champ 2
    ActiveCell.Offset(0, 141).Value = rs2.Fields(4)
    ActiveCell.Offset(0, 75).Value = rs2.Fields(5) '2 colonne à droite celui du champ 3
    ActiveCell.Offset(0, 142).Value = rs2.Fields(5)
    ActiveCell.Offset(0, 76).Value = rs2.Fields(6)
    ActiveCell.Offset(0, 143).Value = rs2.Fields(6)
    ActiveCell.Offset(0, 77).Value = rs2.Fields(7)
    ActiveCell.Offset(0, 144).Value = rs2.Fields(7)
    ActiveCell.Offset(0, 78).Value = rs2.Fields(8)
    ActiveCell.Offset(0, 145).Value = rs2.Fields(8)
    ActiveCell.Offset(0, 79).Value = rs2.Fields(9)
    ActiveCell.Offset(0, 146).Value = rs2.Fields(9)
    ActiveCell.Offset(0, 80).Value = rs2.Fields(10)
    ActiveCell.Offset(0, 147).Value = rs2.Fields(10)
    ActiveCell.Offset(0, 81).Value = rs2.Fields(11)
    ActiveCell.Offset(0, 148).Value = rs2.Fields(11)
    ActiveCell.Offset(0, 82).Value = rs2.Fields(12)
    ActiveCell.Offset(0, 149).Value = rs2.Fields(12)
    ActiveCell.Offset(0, 83).Value = rs2.Fields(13)
    ActiveCell.Offset(0, 150).Value = rs2.Fields(13)
    ActiveCell.Offset(0, 84).Value = rs2.Fields(14)
    ActiveCell.Offset(0, 151).Value = rs2.Fields(14)
 
    ActiveCell.Offset(1).Select 'lorqu'on a ecrit tout on descend
    rs2.MoveNext 'on passe à l'enreg suivant (access)
    Loop
 
rs2.Close
rq2.Close
Set rs2 = Nothing
Set rq2 = Nothing
 
 
 
Set rq3 = db.QueryDefs("Rqt_Data_Regroupe_NO_1")
Set rs3 = rq3.OpenRecordset
 
    Range("A2").Select
    Do While Not rs3.EOF  'Répéter tant qu'on est pas à la fin
    ActiveCell.Offset(0, 88).Value = rs3.Fields(0) 'on écrit le contenu du champ 1
    ActiveCell.Offset(0, 89).Value = rs3.Fields(1) 'à droite celui du champ 2
    ActiveCell.Offset(0, 90).Value = rs3.Fields(2) '2 colonne à droite celui du champ 3
    ActiveCell.Offset(0, 91).Value = rs3.Fields(3)
    ActiveCell.Offset(0, 92).Value = rs3.Fields(4)
    ActiveCell.Offset(0, 93).Value = rs3.Fields(5)
    ActiveCell.Offset(0, 94).Value = rs3.Fields(6)
    ActiveCell.Offset(0, 95).Value = rs3.Fields(7)
    ActiveCell.Offset(0, 96).Value = rs3.Fields(8)
    ActiveCell.Offset(0, 97).Value = rs3.Fields(9)
    ActiveCell.Offset(0, 98).Value = rs3.Fields(10)
    ActiveCell.Offset(0, 99).Value = rs3.Fields(11)
    ActiveCell.Offset(0, 100).Value = rs3.Fields(12)
    ActiveCell.Offset(0, 101).Value = rs3.Fields(13)
    ActiveCell.Offset(0, 102).Value = rs3.Fields(14)
    ActiveCell.Offset(0, 103).Value = rs3.Fields(15)
    ActiveCell.Offset(0, 104).Value = rs3.Fields(16)
    ActiveCell.Offset(0, 105).Value = rs3.Fields(17)
    ActiveCell.Offset(0, 106).Value = rs3.Fields(18)
    ActiveCell.Offset(0, 107).Value = rs3.Fields(19)
    ActiveCell.Offset(0, 108).Value = rs3.Fields(20)
    ActiveCell.Offset(0, 109).Value = rs3.Fields(21)
    ActiveCell.Offset(0, 110).Value = rs3.Fields(22)
    ActiveCell.Offset(0, 111).Value = rs3.Fields(23)
    ActiveCell.Offset(0, 112).Value = rs3.Fields(24)
    ActiveCell.Offset(0, 113).Value = rs3.Fields(25)
    ActiveCell.Offset(0, 114).Value = rs3.Fields(26)
    ActiveCell.Offset(0, 115).Value = rs3.Fields(27)
    ActiveCell.Offset(0, 116).Value = rs3.Fields(28)
    ActiveCell.Offset(0, 117).Value = rs3.Fields(29)
    ActiveCell.Offset(0, 118).Value = rs3.Fields(30)
    ActiveCell.Offset(0, 119).Value = rs3.Fields(31)
    ActiveCell.Offset(0, 120).Value = rs3.Fields(32)
    ActiveCell.Offset(0, 121).Value = rs3.Fields(33)
    ActiveCell.Offset(0, 122).Value = rs3.Fields(34)
    ActiveCell.Offset(0, 123).Value = rs3.Fields(35)
    ActiveCell.Offset(0, 124).Value = rs3.Fields(36)
    ActiveCell.Offset(0, 125).Value = rs3.Fields(37)
    ActiveCell.Offset(0, 126).Value = rs3.Fields(38)
    ActiveCell.Offset(0, 127).Value = rs3.Fields(39)
    ActiveCell.Offset(0, 128).Value = rs3.Fields(40)
    ActiveCell.Offset(0, 129).Value = rs3.Fields(41)
    ActiveCell.Offset(0, 130).Value = rs3.Fields(42)
    ActiveCell.Offset(0, 131).Value = rs3.Fields(43)
    ActiveCell.Offset(0, 132).Value = rs3.Fields(44)
    ActiveCell.Offset(0, 133).Value = rs3.Fields(45)
    ActiveCell.Offset(0, 134).Value = rs3.Fields(46)
    ActiveCell.Offset(0, 135).Value = rs3.Fields(47)
    ActiveCell.Offset(0, 136).Value = rs3.Fields(48)
    ActiveCell.Offset(0, 137).Value = rs3.Fields(49)
    ActiveCell.Offset(0, 138).Value = rs3.Fields(50)
    ActiveCell.Offset(0, 139).Value = rs3.Fields(51)
    ActiveCell.Offset(0, 152).Value = rs3.Fields(52)
    ActiveCell.Offset(0, 153).Value = rs3.Fields(53)
 
    ActiveCell.Offset(1).Select 'lorqu'on a ecrit tout on descend
    rs3.MoveNext 'on passe à l'enreg suivant (access)
    Loop
 
rs3.Close
rq3.Close
Set rs3 = Nothing
Set rq3 = Nothing
 
Set rq4 = db.QueryDefs("Rqt_Data_Regroupe_1_bis")
Set rs4 = rq4.OpenRecordset
 
Range("A2").Select
    Do While Not rs4.EOF  'Répéter tant qu'on est pas à la fin
    ActiveCell.Offset(0, 155).Value = rs4.Fields(0) 'on écrit le contenu du champ 1
    ActiveCell.Offset(0, 156).Value = rs4.Fields(1) 'à droite celui du champ 2
    ActiveCell.Offset(0, 157).Value = rs4.Fields(2) '2 colonne à droite celui du champ 3
    ActiveCell.Offset(0, 158).Value = rs4.Fields(3)
    ActiveCell.Offset(0, 159).Value = rs4.Fields(4)
    ActiveCell.Offset(0, 160).Value = rs4.Fields(5)
    ActiveCell.Offset(0, 161).Value = rs4.Fields(6)
    ActiveCell.Offset(0, 162).Value = rs4.Fields(7)
    ActiveCell.Offset(0, 163).Value = rs4.Fields(8)
    ActiveCell.Offset(0, 164).Value = rs4.Fields(9)
    ActiveCell.Offset(0, 165).Value = rs4.Fields(10)
    ActiveCell.Offset(0, 166).Value = rs4.Fields(11)
    ActiveCell.Offset(0, 167).Value = rs4.Fields(12)
    ActiveCell.Offset(0, 168).Value = rs4.Fields(13)
    ActiveCell.Offset(0, 169).Value = rs4.Fields(14)
    ActiveCell.Offset(0, 170).Value = rs4.Fields(15)
    ActiveCell.Offset(0, 171).Value = rs4.Fields(16)
    ActiveCell.Offset(0, 172).Value = rs4.Fields(17)
    ActiveCell.Offset(0, 173).Value = rs4.Fields(18)
    ActiveCell.Offset(0, 174).Value = rs4.Fields(19)
    ActiveCell.Offset(0, 175).Value = rs4.Fields(20)
    ActiveCell.Offset(0, 176).Value = rs4.Fields(21)
    ActiveCell.Offset(0, 177).Value = rs4.Fields(22)
    ActiveCell.Offset(0, 178).Value = rs4.Fields(23)
    ActiveCell.Offset(0, 179).Value = rs4.Fields(24)
    ActiveCell.Offset(0, 180).Value = rs4.Fields(25)
    ActiveCell.Offset(0, 181).Value = rs4.Fields(26)
    ActiveCell.Offset(0, 182).Value = rs4.Fields(27)
    ActiveCell.Offset(0, 183).Value = rs4.Fields(28)
    ActiveCell.Offset(0, 184).Value = rs4.Fields(29)
    ActiveCell.Offset(0, 185).Value = rs4.Fields(30)
    ActiveCell.Offset(0, 186).Value = rs4.Fields(31)
    ActiveCell.Offset(0, 187).Value = rs4.Fields(32)
    ActiveCell.Offset(0, 188).Value = rs4.Fields(33)
    ActiveCell.Offset(0, 189).Value = rs4.Fields(34)
    ActiveCell.Offset(0, 190).Value = rs4.Fields(35)
    ActiveCell.Offset(0, 191).Value = rs4.Fields(36)
    ActiveCell.Offset(0, 192).Value = rs4.Fields(37)
    ActiveCell.Offset(0, 193).Value = rs4.Fields(38)
    ActiveCell.Offset(0, 194).Value = rs4.Fields(39)
 
    ActiveCell.Offset(1).Select 'lorqu'on a ecrit tout on descend
    rs4.MoveNext 'on passe à l'enreg suivant (access)
    Loop
 
rs4.Close
rq4.Close
Set rs4 = Nothing
Set rq4 = Nothing
 
Set rq5 = db.QueryDefs("Rqt_Moyenne_PCertu_Selection_Type")
Set rs5 = rq5.OpenRecordset
 
Range("A2").Select
    Do While Not rs5.EOF  'Répéter tant qu'on est pas à la fin
    ActiveCell.Offset(0, 196).Value = rs5.Fields(0)
    ActiveCell.Offset(0, 197).Value = rs5.Fields(1) 'on écrit le contenu du champ 1
    ActiveCell.Offset(0, 198).Value = rs5.Fields(2)
    ActiveCell.Offset(0, 199).Value = rs5.Fields(3) 'à droite celui du champ 2
    ActiveCell.Offset(0, 200).Value = rs5.Fields(4)
    ActiveCell.Offset(0, 201).Value = rs5.Fields(5) '2 colonne à droite celui du champ 3
    ActiveCell.Offset(0, 202).Value = rs5.Fields(6)
    ActiveCell.Offset(0, 203).Value = rs5.Fields(7)
    ActiveCell.Offset(0, 204).Value = rs5.Fields(8)
    ActiveCell.Offset(0, 205).Value = rs5.Fields(9)
    ActiveCell.Offset(0, 206).Value = rs5.Fields(10)
    ActiveCell.Offset(0, 207).Value = rs5.Fields(11)
    ActiveCell.Offset(0, 208).Value = rs5.Fields(12)
    ActiveCell.Offset(0, 209).Value = rs5.Fields(13)
    ActiveCell.Offset(0, 210).Value = rs5.Fields(14)
    ActiveCell.Offset(0, 211).Value = rs5.Fields(15)
    ActiveCell.Offset(0, 212).Value = rs5.Fields(16)
    ActiveCell.Offset(0, 213).Value = rs5.Fields(17)
    ActiveCell.Offset(0, 214).Value = rs5.Fields(18)
    ActiveCell.Offset(0, 215).Value = rs5.Fields(19)
    ActiveCell.Offset(0, 216).Value = rs5.Fields(20)
 
    ActiveCell.Offset(1).Select 'lorqu'on a ecrit tout on descend
    rs5.MoveNext 'on passe à l'enreg suivant (access)
    Loop
 
rs5.Close
rq5.Close
Set rs5 = Nothing
Set rq5 = Nothing
 
Set rq6 = db.QueryDefs("Rqt_Liste_Poste_Certu_Sous_Poste")
Set rs6 = rq6.OpenRecordset
 
Range("A2").Select
    Do While Not rs6.EOF  'Répéter tant qu'on est pas à la fin
    ActiveCell.Offset(0, 218).Value = rs6.Fields(0)
    ActiveCell.Offset(0, 219).Value = rs6.Fields(1)
    ActiveCell.Offset(0, 220).Value = rs6.Fields(2)
 
    ActiveCell.Offset(1).Select 'lorqu'on a ecrit tout on descend
    rs6.MoveNext 'on passe à l'enreg suivant (access)
    Loop
 
rs6.Close
rq6.Close
Set rs6 = Nothing
Set rq6 = Nothing
 
Set rq7 = db.QueryDefs("Rqt_Moyenne_SPCertu_Selection_Type")
Set rs7 = rq7.OpenRecordset
 
Range("A2").Select
    Do While Not rs7.EOF  'Répéter tant qu'on est pas à la fin
    ActiveCell.Offset(0, 222).Value = rs7.Fields(0)
    ActiveCell.Offset(0, 223).Value = rs7.Fields(1) 'on écrit le contenu du champ 1
    ActiveCell.Offset(0, 224).Value = rs7.Fields(2)
    ActiveCell.Offset(0, 225).Value = rs7.Fields(3) 'à droite celui du champ 2
    ActiveCell.Offset(0, 226).Value = rs7.Fields(4)
    ActiveCell.Offset(0, 227).Value = rs7.Fields(5) '2 colonne à droite celui du champ 3
    ActiveCell.Offset(0, 228).Value = rs7.Fields(6)
    ActiveCell.Offset(0, 229).Value = rs7.Fields(7)
    ActiveCell.Offset(0, 230).Value = rs7.Fields(8)
    ActiveCell.Offset(0, 231).Value = rs7.Fields(9)
    ActiveCell.Offset(0, 232).Value = rs7.Fields(10)
    ActiveCell.Offset(0, 233).Value = rs7.Fields(11)
    ActiveCell.Offset(0, 234).Value = rs7.Fields(12)
    ActiveCell.Offset(0, 235).Value = rs7.Fields(13)
    ActiveCell.Offset(0, 236).Value = rs7.Fields(14)
    ActiveCell.Offset(0, 237).Value = rs7.Fields(15)
    ActiveCell.Offset(0, 238).Value = rs7.Fields(16)
    ActiveCell.Offset(0, 239).Value = rs7.Fields(17)
    ActiveCell.Offset(0, 240).Value = rs7.Fields(18)
    ActiveCell.Offset(0, 241).Value = rs7.Fields(19)
    ActiveCell.Offset(0, 242).Value = rs7.Fields(20)
    ActiveCell.Offset(0, 243).Value = rs7.Fields(21)
    ActiveCell.Offset(0, 244).Value = rs7.Fields(22)
    ActiveCell.Offset(0, 245).Value = rs7.Fields(23)
    ActiveCell.Offset(0, 246).Value = rs7.Fields(24)
    ActiveCell.Offset(0, 247).Value = rs7.Fields(25)
    ActiveCell.Offset(0, 248).Value = rs7.Fields(26)
    ActiveCell.Offset(0, 249).Value = rs7.Fields(27)
 
    ActiveCell.Offset(1).Select 'lorqu'on a ecrit tout on descend
    rs7.MoveNext 'on passe à l'enreg suivant (access)
    Loop
 
rs7.Close
rq7.Close
Set rs7 = Nothing
Set rq7 = Nothing
 
db.Close
Set db = Nothing
 
MsgBox ("Les requêtes sont exécutées, vous pouvez faire la mise en forme.")

Je libère bien pourtant tous les recordsets.
Je ne comprend pas pourquoi ca ne marche pas.

Je vous met mon code access pour ouvrir le fichier 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
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
Dim IP As String
Dim IP2 As String
Dim IC As String
Dim D1 As String
Dim D2 As String
Dim D11 As String
Dim D22 As String
Dim I1 As String
Dim n As String
Dim nn As String
Dim p As Integer
Dim AV As Double
Dim NV As Double
Dim myrst As DAO.Recordset
Dim ty As Integer
 
Set Db = CurrentDb
p = Me.lmd_P
ty = Me.lmd_F.Column(3)
DoCmd.SetWarnings (False)
 
'-----------------------------Identifiant projet---------------------------------------
sSQL = "SELECT Projet.ID_P FROM Projet GROUP BY Projet.ID_P, Projet.Selection HAVING (((Projet.ID_P)<> " & p & ") AND ((Projet.Selection)=True));"
 
IP = "(Rqt_Détail_Projet.ID_P)=" & p & ""
IP2 = "(Rqt_Détail_Certu_MOA.ID_P)=" & p & ""
 
Set myrst = Db.OpenRecordset(sSQL)
If Not myrst.EOF Then
    ' tant qu'il n'est pas vide
        Do While Not myrst.EOF
        IP = IP & " Or (Rqt_Détail_Projet.ID_P)= " & myrst.Fields("ID_P").Value & ""
        IP2 = IP2 & " Or (Rqt_Détail_Certu_MOA.ID_P)= " & myrst.Fields("ID_P").Value & ""
        myrst.MoveNext
        Loop
End If
myrst.Close
Set myrst = Nothing
 
'-----------------------------Identifiant projet par type---------------------------------------
sSQL = "SELECT Projet.ID_P, Famille.ID_Type"
sSQL = sSQL & " FROM Famille INNER JOIN Projet ON Famille.ID_F = Projet.ID_F"
sSQL = sSQL & " WHERE (((Projet.ID_P)<>" & p & ") AND ((Famille.ID_Type)=" & ty & "));"
 
 
IPT = "(Rqt_Détail_Certu_MOA.ID_P)=" & p & ""
 
Set myrst = Db.OpenRecordset(sSQL)
If Not myrst.EOF Then
    ' tant qu'il n'est pas vide
        Do While Not myrst.EOF
        IPT = IPT & " Or (Rqt_Détail_Certu_MOA.ID_P)= " & myrst.Fields("ID_P").Value & ""
        myrst.MoveNext
        Loop
End If
myrst.Close
Set myrst = Nothing
 
'------------------------------Identifiant Poste Certu------------------------------------------
sSQL = "SELECT Liste_Poste_Certu.Num_Certu FROM Liste_Poste_Certu GROUP BY Liste_Poste_Certu.Num_Certu, Liste_Poste_Certu.Selection HAVING (((Liste_Poste_Certu.Selection)=True));"
i = 0
Set myrst = Db.OpenRecordset(sSQL)
If Not myrst.EOF Then
    ' tant qu'il n'est pas vide
        Do While Not myrst.EOF
        i = i + 1
 
            If i = 1 Then
            IC = "(Rqt_Data_Par_PCertu.Num_Certu)= " & myrst.Fields("Num_Certu").Value & ""
            Else
            IC = IC & " Or (Rqt_Data_Par_PCertu.Num_Certu)= " & myrst.Fields("Num_Certu").Value & ""
            End If
 
        myrst.MoveNext
        Loop
End If
myrst.Close
Set myrst = Nothing
 
 
'-------------------------------------------------suite programme------------------------------------
sSQL = "Delete * FROM Tbl_MAJ_CE"
DoCmd.RunSQL (sSQL)
 
sSQL = "SELECT Rqt_Détail_Projet.ID_P, Rqt_Détail_Projet.Montant_Projet,Rqt_Détail_Projet.CE_Projet, Rqt_Détail_Certu_MOA.ID_DP,Rqt_Détail_Certu_MOA.ID_DP2,Rqt_Détail_Certu_MOA.ID_PMOA,Rqt_Détail_Certu_MOA.ID_SPMOA,Rqt_Détail_Certu_MOA.ID_DMOA,Rqt_Détail_Certu_MOA.ID_SP_Certu,Rqt_Détail_Certu_MOA.ID_Desig,Rqt_Détail_Certu_MOA.ID_R, Rqt_Détail_Certu_MOA.Nom_Ouvrage,Rqt_Détail_Certu_MOA.Num_Certu,Rqt_Détail_Certu_MOA.Montant_PCertu, Rqt_Détail_Certu_MOA.PU_PCertu, Rqt_Détail_Certu_MOA.Indice_PCertu, Rqt_Détail_Certu_MOA.CE_PCertu"
sSQL = sSQL & " FROM Rqt_Détail_Projet INNER JOIN Rqt_Détail_Certu_MOA ON Rqt_Détail_Projet.ID_P = Rqt_Détail_Certu_MOA.ID_P"
sSQL = sSQL & " WHERE ((" & IP & "));"
 
    Set myrst = Db.OpenRecordset(sSQL)
 
    'si le recordset n'est pas vide
    If Not myrst.EOF Then
    ' tant qu'il n'est pas vide
        Do While Not myrst.EOF
        D1 = myrst.Fields("CE_PCertu").Value
        I1 = myrst.Fields("Indice_PCertu").Value
        PUC = myrst.Fields("PU_PCertu").Value
        MP = myrst.Fields("Montant_Projet").Value
        MPC = myrst.Fields("Montant_PCertu").Value
        ID = myrst.Fields("ID_DP").Value
        ID2 = myrst.Fields("ID_DP2").Value
        D2 = Me.Lmd_D.Column(1)
        D3 = myrst.Fields("CE_Projet").Value
'----------------Montant et PU-----------------------------------------
 
        If Len(D1) > 0 And Len(D2) > 0 Then
 
            a = Split("" & D1 & "", "/")
            If a(0) <= 12 Then
            D11 = a(1) & "/" & a(0) & "/" & a(2)
            End If
 
            b = Split("" & D2 & "", "/")
            If b(0) <= 12 Then
            D22 = b(1) & "/" & b(0) & "/" & b(2)
            End If
 
            C = Split("" & D3 & "", "/")
            If C(0) <= 12 Then
            D33 = C(1) & "/" & C(0) & "/" & C(2)
            End If
 
            AV = DLookup("" & I1 & "", "Liste_Indice", "[Date_Indice]= #" & D11 & "#")
            AVP = DLookup("" & I1 & "", "Liste_Indice", "[Date_Indice]= #" & D33 & "#")
            NV = DLookup("" & I1 & "", "Liste_Indice", "[Date_Indice]= #" & D22 & "#")
 
            tmp = Round(((MP * NV) / AVP), 0)
            tmp = Replace(tmp, ",", ".")
            tmpc = Round(((MPC * NV) / AV), 0)
            tmpc = Replace(tmpc, ",", ".")
            tc = Round((PUC * NV) / AV, 2)
            tc = Replace(tc, ",", ".")
        Else
            tc = PUC
            tmp = MP
            tmpc = MPC
 
        End If
 
'---------------------------------Suite programme----------------------------------------------------
 
        nn = "x"
        vv = "x"
 
            For Each f In myrst.Fields
            n = f.Name & 2
            v = myrst.Fields("[" & f.Name & "]").Value
 
                If nn = "x" Then
                nn = "[" & n & "]"
                Else
                nn = nn & ", " & "[" & n & "]"
                End If
 
                If vv = "x" Then
                vv = "'" & v & "'"
                Else
                vv = vv & ", " & "'" & v & "'"
                End If
 
 
            Next
            sSQL = "INSERT INTO [Tbl_MAJ_CE] (" & nn & ") VALUES (" & vv & ")"
            DoCmd.RunSQL (sSQL)
            sSQL = "UPDATE [Tbl_MAJ_CE] SET PU_PCertu2= " & tc & ",Montant_Projet2=" & tmp & ",Montant_PCertu2=" & tmpc & ", CE_PCertu2= #" & D22 & "#, CE_Projet2= #" & D22 & "#  WHERE [ID_DP2]=" & ID & ""
            DoCmd.RunSQL (sSQL)
 
        myrst.MoveNext
        Loop
    End If
 
myrst.Close
Set myrst = Nothing
 
DoCmd.SetWarnings (True)
 
sSQL = "SELECT Rqt_Détail_Certu_MOA.ID_P, Rqt_Data_Par_PCertu.Montant_Projet AS MP, Rqt_Data_Par_PCertu.Montant_Projet2 AS MPA, Rqt_Data_Par_PCertu.CE_Projet AS CEP, Rqt_Data_Par_PCertu.CE_Actu AS CE_PA, Rqt_Data_Par_PCertu.Num_Certu AS NC, Rqt_Data_Par_PCertu.Nom_Certu, Rqt_Data_Par_PCertu.MPC, Rqt_Data_Par_PCertu.MPCA, Rqt_Data_Par_PCertu.MPCSSAV, Rqt_Data_Par_PCertu.MPCASSAV, Rqt_Data_Par_PCertu.CE AS CE_PC, Rqt_Data_Par_SPCertu.Nom_SP_Certu, Rqt_Data_Par_SPCertu.MSPC, Rqt_Data_Par_SPCertu.MSPCA, Rqt_Data_Par_SPCertu.MSPCSSAV, Rqt_Data_Par_SPCertu.MSPCASSAV, Rqt_Data_Par_SPCertu.CE AS CE_SPC, Rqt_Data_Par_Desig.Nom_Desig, Rqt_Data_Par_Desig.MD, Rqt_Data_Par_Desig.MDA, Rqt_Data_Par_Desig.MDSSAV, Rqt_Data_Par_Desig.MDASSAV, Rqt_Data_Par_Desig.CE AS CE_D, Rqt_Data_Par_Ressources.Nom_R, Rqt_Data_Par_Ressources.MR, Rqt_Data_Par_Ressources.MRA, Rqt_Data_Par_Ressources.MRSSAV, Rqt_Data_Par_Ressources.MRASSAV, Rqt_Data_Par_Ressources.CE AS CE_R, Rqt_Data_Par_PCertu.Longueur,"
sSQL = sSQL & " Rqt_Data_Par_PCertu.Longueur_Travailler , Rqt_Data_Par_PCertu.GLO , Rqt_Data_Par_PCertu.Nb_Stations_simple, Rqt_Data_Par_PCertu.Nb_Stations_double, Rqt_Data_Par_PCertu.Capacite_SMR, Rqt_Data_Par_PCertu.Montant_BT, Rqt_Data_Par_PCertu.Montant_BT_Actu, Rqt_Data_Par_PCertu.Montant_BT_Sans_SAV, Rqt_Data_Par_PCertu.Montant_BT_Actu_Sans_SAV, Rqt_Détail_Certu_MOA.Nom_PMOA, Rqt_Détail_Certu_MOA.Nom_SPMOA, Rqt_Détail_Certu_MOA.Nom_DMOA"
sSQL = sSQL & " FROM (((Rqt_Détail_Certu_MOA LEFT JOIN Rqt_Data_Par_PCertu ON (Rqt_Détail_Certu_MOA.ID_P = Rqt_Data_Par_PCertu.ID_P) AND (Rqt_Détail_Certu_MOA.Num_Certu = Rqt_Data_Par_PCertu.Num_Certu)) LEFT JOIN Rqt_Data_Par_SPCertu ON (Rqt_Détail_Certu_MOA.ID_P = Rqt_Data_Par_SPCertu.ID_P) AND (Rqt_Détail_Certu_MOA.Num_Certu = Rqt_Data_Par_SPCertu.Num_Certu) AND (Rqt_Détail_Certu_MOA.Nom_SP_Certu = Rqt_Data_Par_SPCertu.Nom_SP_Certu)) LEFT JOIN Rqt_Data_Par_Desig ON (Rqt_Détail_Certu_MOA.ID_P = Rqt_Data_Par_Desig.ID_P) AND (Rqt_Détail_Certu_MOA.Num_Certu = Rqt_Data_Par_Desig.Num_Certu) AND (Rqt_Détail_Certu_MOA.Nom_SP_Certu = Rqt_Data_Par_Desig.Nom_SP_Certu) AND (Rqt_Détail_Certu_MOA.Nom_Desig = Rqt_Data_Par_Desig.Nom_Desig)) LEFT JOIN Rqt_Data_Par_Ressources ON (Rqt_Détail_Certu_MOA.ID_P = Rqt_Data_Par_Ressources.ID_P) AND (Rqt_Détail_Certu_MOA.Num_Certu = Rqt_Data_Par_Ressources.Num_Certu) AND (Rqt_Détail_Certu_MOA.Nom_SP_Certu = Rqt_Data_Par_Ressources.Nom_SP_Certu) AND"
sSQL = sSQL & " (Rqt_Détail_Certu_MOA.Nom_Desig = Rqt_Data_Par_Ressources.Nom_Desig) AND (Rqt_Détail_Certu_MOA.Nom_R = Rqt_Data_Par_Ressources.Nom_R)"
sSQL = sSQL & " WHERE (((Rqt_Détail_Certu_MOA.ID_P)=" & p & "));"
 
    DoCmd.DeleteObject acQuery, "Rqt_Data_Regroupe_0"
    CurrentDb.CreateQueryDef "Rqt_Data_Regroupe_0", sSQL
 
sSQL = "SELECT Rqt_Détail_Certu_MOA.ID_P, Rqt_Data_Par_PCertu_NO.Montant_Projet AS MP, Rqt_Data_Par_PCertu_NO.Montant_Projet2 AS MPA, Rqt_Data_Par_PCertu_NO.CE_Projet AS CEP, Rqt_Data_Par_PCertu_NO.CE_Actu AS CE_PA, Rqt_Data_Par_PCertu_NO.Num_Certu AS NC, Rqt_Data_Par_PCertu_NO.Nom_Certu, Rqt_Data_Par_PCertu_NO.Nom_Ouvrage, Rqt_Data_Par_PCertu_NO.MPC, Rqt_Data_Par_PCertu_NO.MPCA, Rqt_Data_Par_PCertu_NO.MPCSSAV, Rqt_Data_Par_PCertu_NO.MPCASSAV, Rqt_Data_Par_PCertu_NO.CE AS CE_PC, Rqt_Data_Par_SPCertu_NO.Nom_SP_Certu, Rqt_Data_Par_SPCertu_NO.MSPC, Rqt_Data_Par_SPCertu_NO.MSPCA, Rqt_Data_Par_SPCertu_NO.MSPCSSAV, Rqt_Data_Par_SPCertu_NO.MSPCASSAV, Rqt_Data_Par_SPCertu_NO.CE AS CE_SPC, Rqt_Data_Par_Desig_NO.Nom_Desig, Rqt_Data_Par_Desig_NO.MD, Rqt_Data_Par_Desig_NO.MDA, Rqt_Data_Par_Desig_NO.MDSSAV, Rqt_Data_Par_Desig_NO.MDASSAV, Rqt_Data_Par_Desig_NO.CE AS CE_D, Rqt_Data_Par_Ressources_NO.Nom_R, Rqt_Data_Par_Ressources_NO.MR, Rqt_Data_Par_Ressources_NO.MRA, Rqt_Data_Par_Ressources_NO.MRSSAV,"
sSQL = sSQL & " Rqt_Data_Par_Ressources_NO.MRASSAV, Rqt_Data_Par_Ressources_NO.CE AS CE_R, Rqt_Data_Par_PCertu_NO.Longueur, Rqt_Data_Par_PCertu_NO.Longueur_Travailler, Rqt_Data_Par_PCertu_NO.GLO, Rqt_Data_Par_PCertu_NO.Nb_Stations_simple, Rqt_Data_Par_PCertu_NO.Nb_Stations_double, Rqt_Data_Par_PCertu_NO.Capacite_SMR, Rqt_Data_Par_PCertu_NO.Montant_BT, Rqt_Data_Par_PCertu_NO.Montant_BT_Actu, Rqt_Data_Par_PCertu_NO.Montant_BT_Sans_SAV, Rqt_Data_Par_PCertu_NO.Montant_BT_Actu_Sans_SAV, Rqt_Détail_Certu_MOA.Nom_PMOA, Rqt_Détail_Certu_MOA.Nom_SPMOA, Rqt_Détail_Certu_MOA.Nom_DMOA"
sSQL = sSQL & " FROM (((Rqt_Détail_Certu_MOA LEFT JOIN Rqt_Data_Par_PCertu_NO ON (Rqt_Détail_Certu_MOA.ID_P = Rqt_Data_Par_PCertu_NO.ID_P) AND (Rqt_Détail_Certu_MOA.Num_Certu = Rqt_Data_Par_PCertu_NO.Num_Certu) AND (Rqt_Détail_Certu_MOA.Nom_Ouvrage = Rqt_Data_Par_PCertu_NO.Nom_Ouvrage)) LEFT JOIN Rqt_Data_Par_SPCertu_NO ON (Rqt_Détail_Certu_MOA.ID_P = Rqt_Data_Par_SPCertu_NO.ID_P) AND (Rqt_Détail_Certu_MOA.Num_Certu = Rqt_Data_Par_SPCertu_NO.Num_Certu) AND (Rqt_Détail_Certu_MOA.Nom_Ouvrage = Rqt_Data_Par_SPCertu_NO.Nom_Ouvrage) AND (Rqt_Détail_Certu_MOA.Nom_SP_Certu = Rqt_Data_Par_SPCertu_NO.Nom_SP_Certu)) LEFT JOIN Rqt_Data_Par_Desig_NO ON (Rqt_Détail_Certu_MOA.ID_P = Rqt_Data_Par_Desig_NO.ID_P) AND (Rqt_Détail_Certu_MOA.Num_Certu = Rqt_Data_Par_Desig_NO.Num_Certu) AND (Rqt_Détail_Certu_MOA.Nom_Ouvrage = Rqt_Data_Par_Desig_NO.Nom_Ouvrage) AND (Rqt_Détail_Certu_MOA.Nom_SP_Certu = Rqt_Data_Par_Desig_NO.Nom_SP_Certu) AND (Rqt_Détail_Certu_MOA.Nom_Desig = Rqt_Data_Par_Desig_NO.Nom_Desig)) LEFT JOIN"
sSQL = sSQL & " Rqt_Data_Par_Ressources_NO On (Rqt_Détail_Certu_MOA.ID_P = Rqt_Data_Par_Ressources_NO.ID_P) And (Rqt_Détail_Certu_MOA.Num_Certu = Rqt_Data_Par_Ressources_NO.Num_Certu) And (Rqt_Détail_Certu_MOA.Nom_Ouvrage = Rqt_Data_Par_Ressources_NO.Nom_Ouvrage) And (Rqt_Détail_Certu_MOA.Nom_SP_Certu = Rqt_Data_Par_Ressources_NO.Nom_SP_Certu) And (Rqt_Détail_Certu_MOA.Nom_Desig = Rqt_Data_Par_Ressources_NO.Nom_Desig) And (Rqt_Détail_Certu_MOA.Nom_R = Rqt_Data_Par_Ressources_NO.Nom_R)"
sSQL = sSQL & " WHERE (((Rqt_Détail_Certu_MOA.ID_P)=" & p & "));"
 
    DoCmd.DeleteObject acQuery, "Rqt_Data_Regroupe_NO_0"
    CurrentDb.CreateQueryDef "Rqt_Data_Regroupe_NO_0", sSQL
 
sSQL = "SELECT Rqt_Détail_Projet.ID_Infra, Rqt_Détail_Projet.Nom_Infra, Rqt_Détail_Projet.ID_F, Rqt_Détail_Projet.Nom_F, Rqt_Détail_Projet.Nom_Type, Rqt_Détail_Projet.ID_P, Rqt_Détail_Projet.Nom_P, Rqt_Détail_Projet.Montant_Projet, Tbl_MAJ_CE.Montant_Projet2 AS Montant_Projet_Actu, Rqt_Détail_Projet.Longueur, Rqt_Détail_Projet.Longueur_Travailler, Rqt_Détail_Projet.GLO, Rqt_Détail_Projet.Nb_Stations_simple, Rqt_Détail_Projet.Nb_Stations_double, Rqt_Détail_Projet.Capacite_SMR, Rqt_Détail_Projet.ID_MOE, Rqt_Détail_Projet.Nom_MOE, Rqt_Détail_Projet.ID_MOA, Rqt_Détail_Projet.Nom_MOA, Rqt_Détail_Projet.ID_Source, Rqt_Détail_Projet.Nom_Source, Rqt_Détail_Projet.Type_Source, Rqt_Détail_Projet.Lieu_Source, Rqt_Détail_Projet.Producteur, Rqt_Détail_Projet.Etape, Rqt_Détail_Projet.CE_Projet, Tbl_MAJ_CE.CE_Projet2 AS CE_Projet_Actu"
sSQL = sSQL & " FROM Rqt_Détail_Projet INNER JOIN Tbl_MAJ_CE ON Rqt_Détail_Projet.ID_P = Tbl_MAJ_CE.ID_P2"
sSQL = sSQL & " GROUP BY Rqt_Détail_Projet.ID_Infra, Rqt_Détail_Projet.Nom_Infra, Rqt_Détail_Projet.ID_F, Rqt_Détail_Projet.Nom_F, Rqt_Détail_Projet.Nom_Type, Rqt_Détail_Projet.ID_P, Rqt_Détail_Projet.Nom_P, Rqt_Détail_Projet.Montant_Projet, Tbl_MAJ_CE.Montant_Projet2, Rqt_Détail_Projet.Longueur, Rqt_Détail_Projet.Longueur_Travailler, Rqt_Détail_Projet.GLO, Rqt_Détail_Projet.Nb_Stations_simple, Rqt_Détail_Projet.Nb_Stations_double, Rqt_Détail_Projet.Capacite_SMR, Rqt_Détail_Projet.ID_MOE, Rqt_Détail_Projet.Nom_MOE, Rqt_Détail_Projet.ID_MOA, Rqt_Détail_Projet.Nom_MOA, Rqt_Détail_Projet.ID_Source, Rqt_Détail_Projet.Nom_Source, Rqt_Détail_Projet.Type_Source, Rqt_Détail_Projet.Lieu_Source, Rqt_Détail_Projet.Producteur, Rqt_Détail_Projet.Etape, Rqt_Détail_Projet.CE_Projet, Tbl_MAJ_CE.CE_Projet2"
sSQL = sSQL & " HAVING (((Rqt_Détail_Projet.ID_P)=" & p & "));"
 
    DoCmd.DeleteObject acQuery, "Rqt_Fiche_Projet_Caractéristique"
    CurrentDb.CreateQueryDef "Rqt_Fiche_Projet_Caractéristique", sSQL
 
sSQL = "SELECT Rqt_Data_fiche_projet.ID_P, Rqt_Data_fiche_projet.Num_Certu, Rqt_Data_fiche_projet.Nom_Certu, Rqt_Data_fiche_projet.Nom_SP_Certu, Rqt_Data_fiche_projet.Nom_Desig, Rqt_Data_fiche_projet.Nom_R, Rqt_Data_fiche_projet.Nom_Ouvrage, Rqt_Data_fiche_projet.Nom_PMOA, Rqt_Data_fiche_projet.Nom_SPMOA, Rqt_Data_fiche_projet.Nom_DMOA, Rqt_Data_fiche_projet.Montant_PCertu AS MPMOA, Rqt_Data_fiche_projet.Montant_PCertu2 AS MPMOAA, Round(([Montant_PCertu]/(1+[SAV_PCertu])),0) AS MPMOASSAV, Round(([Montant_PCertu2]/(1+[SAV_PCertu])),0) AS MPMOAASSAV, Rqt_Data_fiche_projet.PU_PCertu AS PUMOA, Rqt_Data_fiche_projet.PU_PCertu2 AS PUAMOA, Rqt_Data_fiche_projet.Unite_PCertu, Rqt_Data_fiche_projet.CE_PCertu AS CE, Rqt_Data_fiche_projet.CE_PCertu2 AS CE_Actu, Rqt_Data_fiche_projet.Montant_Projet"
sSQL = sSQL & " FROM Rqt_Data_fiche_projet INNER JOIN Rqt_Base_Travaux ON Rqt_Data_fiche_projet.ID_P = Rqt_Base_Travaux.ID_P"
sSQL = sSQL & " GROUP BY Rqt_Data_fiche_projet.ID_P, Rqt_Data_fiche_projet.Num_Certu, Rqt_Data_fiche_projet.Nom_Certu, Rqt_Data_fiche_projet.Nom_SP_Certu, Rqt_Data_fiche_projet.Nom_Desig, Rqt_Data_fiche_projet.Nom_R, Rqt_Data_fiche_projet.Nom_Ouvrage, Rqt_Data_fiche_projet.Nom_PMOA, Rqt_Data_fiche_projet.Nom_SPMOA, Rqt_Data_fiche_projet.Nom_DMOA, Rqt_Data_fiche_projet.Montant_PCertu, Rqt_Data_fiche_projet.Montant_PCertu2, Round(([Montant_PCertu]/(1+[SAV_PCertu])),0), Round(([Montant_PCertu2]/(1+[SAV_PCertu])),0), Rqt_Data_fiche_projet.PU_PCertu, Rqt_Data_fiche_projet.PU_PCertu2, Rqt_Data_fiche_projet.Unite_PCertu, Rqt_Data_fiche_projet.CE_PCertu, Rqt_Data_fiche_projet.CE_PCertu2, Rqt_Data_fiche_projet.Montant_Projet"
sSQL = sSQL & " HAVING (((Rqt_Data_fiche_projet.ID_P)=" & p & "));"
 
    DoCmd.DeleteObject acQuery, "Rqt_Data_Par_PMOA"
    CurrentDb.CreateQueryDef "Rqt_Data_Par_PMOA", sSQL
 
sSQL = "SELECT Rqt_Détail_Certu_MOA.ID_P, Rqt_Data_Par_PCertu.Nom_P, Rqt_Data_Par_PCertu.Montant_Projet AS MP, Rqt_Data_Par_PCertu.Montant_Projet2 AS MPA, Rqt_Data_Par_PCertu.CE_Projet AS CEP, Rqt_Data_Par_PCertu.CE_Actu AS CE_PA,Rqt_Data_Par_PCertu.Etape, Rqt_Data_Par_PCertu.Num_Certu AS NC, Rqt_Data_Par_PCertu.Nom_Certu, Rqt_Data_Par_PCertu.MPC, Rqt_Data_Par_PCertu.MPCA, Rqt_Data_Par_PCertu.MPCSSAV, Rqt_Data_Par_PCertu.MPCASSAV, Rqt_Data_Par_PCertu.CE AS CE_PC, Rqt_Data_Par_SPCertu.Nom_SP_Certu, Rqt_Data_Par_SPCertu.MSPC,"
sSQL = sSQL & " Rqt_Data_Par_SPCertu.MSPCA, Rqt_Data_Par_SPCertu.MSPCSSAV, Rqt_Data_Par_SPCertu.MSPCASSAV, Rqt_Data_Par_SPCertu.CE AS CE_SPC, Rqt_Data_Par_Desig.Nom_Desig, Rqt_Data_Par_Desig.MD, Rqt_Data_Par_Desig.MDA, Rqt_Data_Par_Desig.MDSSAV, Rqt_Data_Par_Desig.MDASSAV, Rqt_Data_Par_Desig.CE AS CE_D, Rqt_Data_Par_Ressources.Nom_R, Rqt_Data_Par_Ressources.MR, Rqt_Data_Par_Ressources.MRA, Rqt_Data_Par_Ressources.MRSSAV, Rqt_Data_Par_Ressources.MRASSAV, Rqt_Data_Par_Ressources.CE AS CE_R, Rqt_Data_Par_PCertu.Longueur,"
sSQL = sSQL & " Rqt_Data_Par_PCertu.Longueur_Travailler , Rqt_Data_Par_PCertu.GLO, Rqt_Data_Par_PCertu.Nb_Stations_simple, Rqt_Data_Par_PCertu.Nb_Stations_double, Rqt_Data_Par_PCertu.Capacite_SMR, Rqt_Data_Par_PCertu.Montant_BT, Rqt_Data_Par_PCertu.Montant_BT_Actu, Rqt_Data_Par_PCertu.Montant_BT_Sans_SAV, Rqt_Data_Par_PCertu.Montant_BT_Actu_Sans_SAV"
sSQL = sSQL & " FROM (((Rqt_Détail_Certu_MOA LEFT JOIN Rqt_Data_Par_PCertu ON (Rqt_Détail_Certu_MOA.Num_Certu = Rqt_Data_Par_PCertu.Num_Certu) AND (Rqt_Détail_Certu_MOA.ID_P = Rqt_Data_Par_PCertu.ID_P)) LEFT JOIN Rqt_Data_Par_SPCertu ON (Rqt_Détail_Certu_MOA.Nom_SP_Certu = Rqt_Data_Par_SPCertu.Nom_SP_Certu) AND (Rqt_Détail_Certu_MOA.Num_Certu = Rqt_Data_Par_SPCertu.Num_Certu) AND (Rqt_Détail_Certu_MOA.ID_P = Rqt_Data_Par_SPCertu.ID_P)) LEFT JOIN Rqt_Data_Par_Desig ON (Rqt_Détail_Certu_MOA.Nom_Desig = Rqt_Data_Par_Desig.Nom_Desig) AND (Rqt_Détail_Certu_MOA.Nom_SP_Certu = Rqt_Data_Par_Desig.Nom_SP_Certu) AND (Rqt_Détail_Certu_MOA.Num_Certu = Rqt_Data_Par_Desig.Num_Certu) AND (Rqt_Détail_Certu_MOA.ID_P = Rqt_Data_Par_Desig.ID_P)) LEFT JOIN Rqt_Data_Par_Ressources ON (Rqt_Détail_Certu_MOA.Nom_R = Rqt_Data_Par_Ressources.Nom_R) AND (Rqt_Détail_Certu_MOA.Nom_Desig = Rqt_Data_Par_Ressources.Nom_Desig) AND (Rqt_Détail_Certu_MOA.Nom_SP_Certu = Rqt_Data_Par_Ressources.Nom_SP_Certu) AND"
sSQL = sSQL & " (Rqt_Détail_Certu_MOA.Num_Certu = Rqt_Data_Par_Ressources.Num_Certu) AND (Rqt_Détail_Certu_MOA.ID_P = Rqt_Data_Par_Ressources.ID_P)"
sSQL = sSQL & " GROUP BY Rqt_Détail_Certu_MOA.ID_P, Rqt_Data_Par_PCertu.Nom_P, Rqt_Data_Par_PCertu.Montant_Projet, Rqt_Data_Par_PCertu.Montant_Projet2, Rqt_Data_Par_PCertu.CE_Projet, Rqt_Data_Par_PCertu.CE_Actu,Rqt_Data_Par_PCertu.Etape, Rqt_Data_Par_PCertu.Num_Certu , Rqt_Data_Par_PCertu.Nom_Certu, Rqt_Data_Par_PCertu.MPC, Rqt_Data_Par_PCertu.MPCA, Rqt_Data_Par_PCertu.MPCSSAV, Rqt_Data_Par_PCertu.MPCASSAV, "
sSQL = sSQL & " Rqt_Data_Par_PCertu.ce , Rqt_Data_Par_SPCertu.Nom_SP_Certu, Rqt_Data_Par_SPCertu.MSPC, Rqt_Data_Par_SPCertu.MSPCA, Rqt_Data_Par_SPCertu.MSPCSSAV, Rqt_Data_Par_SPCertu.MSPCASSAV, Rqt_Data_Par_SPCertu.ce, Rqt_Data_Par_Desig.Nom_Desig, Rqt_Data_Par_Desig.MD, Rqt_Data_Par_Desig.MDA, Rqt_Data_Par_Desig.MDSSAV, Rqt_Data_Par_Desig.MDASSAV, Rqt_Data_Par_Desig.ce, Rqt_Data_Par_Ressources.Nom_R, Rqt_Data_Par_Ressources.MR, Rqt_Data_Par_Ressources.MRA, Rqt_Data_Par_Ressources.MRSSAV, Rqt_Data_Par_Ressources.MRASSAV, Rqt_Data_Par_Ressources.ce, Rqt_Data_Par_PCertu.Longueur, Rqt_Data_Par_PCertu.Longueur_Travailler, Rqt_Data_Par_PCertu.GLO, "
sSQL = sSQL & " Rqt_Data_Par_PCertu.nb_Stations_simple , Rqt_Data_Par_PCertu.Nb_Stations_double, Rqt_Data_Par_PCertu.Capacite_SMR, Rqt_Data_Par_PCertu.Montant_BT, Rqt_Data_Par_PCertu.Montant_BT_Actu, Rqt_Data_Par_PCertu.Montant_BT_Sans_SAV, Rqt_Data_Par_PCertu.Montant_BT_Actu_Sans_SAV"
sSQL = sSQL & " HAVING ((" & IP2 & ") AND (" & IC & "));"
 
    DoCmd.DeleteObject acQuery, "Rqt_Data_Regroupe_0_bis"
    CurrentDb.CreateQueryDef "Rqt_Data_Regroupe_0_bis", sSQL
 
 
sSQL = "SELECT Rqt_Détail_Certu_MOA.ID_P, Rqt_Data_Par_PCertu.Nom_P, Rqt_Data_Par_PCertu.Montant_Projet AS MP, Rqt_Data_Par_PCertu.Montant_Projet2 AS MPA, Rqt_Data_Par_PCertu.CE_Projet AS CEP, Rqt_Data_Par_PCertu.CE_Actu AS CE_PA, Rqt_Data_Par_PCertu.Num_Certu AS NC, Rqt_Data_Par_PCertu.Nom_Certu, Rqt_Data_Par_PCertu.MPC, Rqt_Data_Par_PCertu.MPCA, Rqt_Data_Par_PCertu.MPCSSAV, Rqt_Data_Par_PCertu.MPCASSAV, Rqt_Data_Par_PCertu.CE AS CE_PC, Rqt_Data_Par_SPCertu.Nom_SP_Certu, Rqt_Data_Par_SPCertu.MSPC, Rqt_Data_Par_SPCertu.MSPCA, Rqt_Data_Par_SPCertu.MSPCSSAV, Rqt_Data_Par_SPCertu.MSPCASSAV, Rqt_Data_Par_SPCertu.CE AS CE_SPC, Rqt_Data_Par_Desig.Nom_Desig, Rqt_Data_Par_Desig.MD, Rqt_Data_Par_Desig.MDA, Rqt_Data_Par_Desig.MDSSAV, Rqt_Data_Par_Desig.MDASSAV, Rqt_Data_Par_Desig.CE AS CE_D, Rqt_Data_Par_Ressources.Nom_R, Rqt_Data_Par_Ressources.MR, Rqt_Data_Par_Ressources.MRA, Rqt_Data_Par_Ressources.MRSSAV, Rqt_Data_Par_Ressources.MRASSAV, Rqt_Data_Par_Ressources.CE AS CE_R, Rqt_Data_Par_PCertu.Longueur,"
sSQL = sSQL & " Rqt_Data_Par_PCertu.Longueur_Travailler , Rqt_Data_Par_PCertu.GLO, Rqt_Data_Par_PCertu.Nb_Stations_simple, Rqt_Data_Par_PCertu.Nb_Stations_double, Rqt_Data_Par_PCertu.Capacite_SMR, Rqt_Data_Par_PCertu.Montant_BT, Rqt_Data_Par_PCertu.Montant_BT_Actu, Rqt_Data_Par_PCertu.Montant_BT_Sans_SAV, Rqt_Data_Par_PCertu.Montant_BT_Actu_Sans_SAV"
sSQL = sSQL & " FROM (((Rqt_Détail_Certu_MOA LEFT JOIN Rqt_Data_Par_PCertu ON (Rqt_Détail_Certu_MOA.Num_Certu = Rqt_Data_Par_PCertu.Num_Certu) AND (Rqt_Détail_Certu_MOA.ID_P = Rqt_Data_Par_PCertu.ID_P)) LEFT JOIN Rqt_Data_Par_SPCertu ON (Rqt_Détail_Certu_MOA.Nom_SP_Certu = Rqt_Data_Par_SPCertu.Nom_SP_Certu) AND (Rqt_Détail_Certu_MOA.Num_Certu = Rqt_Data_Par_SPCertu.Num_Certu) AND (Rqt_Détail_Certu_MOA.ID_P = Rqt_Data_Par_SPCertu.ID_P)) LEFT JOIN Rqt_Data_Par_Desig ON (Rqt_Détail_Certu_MOA.Nom_Desig = Rqt_Data_Par_Desig.Nom_Desig) AND (Rqt_Détail_Certu_MOA.Nom_SP_Certu = Rqt_Data_Par_Desig.Nom_SP_Certu) AND (Rqt_Détail_Certu_MOA.Num_Certu = Rqt_Data_Par_Desig.Num_Certu) AND (Rqt_Détail_Certu_MOA.ID_P = Rqt_Data_Par_Desig.ID_P)) LEFT JOIN Rqt_Data_Par_Ressources ON (Rqt_Détail_Certu_MOA.Nom_R = Rqt_Data_Par_Ressources.Nom_R) AND (Rqt_Détail_Certu_MOA.Nom_Desig = Rqt_Data_Par_Ressources.Nom_Desig) AND (Rqt_Détail_Certu_MOA.Nom_SP_Certu = Rqt_Data_Par_Ressources.Nom_SP_Certu) AND"
sSQL = sSQL & " (Rqt_Détail_Certu_MOA.Num_Certu = Rqt_Data_Par_Ressources.Num_Certu) AND (Rqt_Détail_Certu_MOA.ID_P = Rqt_Data_Par_Ressources.ID_P)"
sSQL = sSQL & " GROUP BY Rqt_Détail_Certu_MOA.ID_P, Rqt_Data_Par_PCertu.Nom_P, Rqt_Data_Par_PCertu.Montant_Projet, Rqt_Data_Par_PCertu.Montant_Projet2, Rqt_Data_Par_PCertu.CE_Projet, Rqt_Data_Par_PCertu.CE_Actu, Rqt_Data_Par_PCertu.Num_Certu, Rqt_Data_Par_PCertu.Nom_Certu, Rqt_Data_Par_PCertu.MPC, Rqt_Data_Par_PCertu.MPCA, Rqt_Data_Par_PCertu.MPCSSAV, Rqt_Data_Par_PCertu.MPCASSAV, Rqt_Data_Par_PCertu.CE, Rqt_Data_Par_SPCertu.Nom_SP_Certu, Rqt_Data_Par_SPCertu.MSPC, Rqt_Data_Par_SPCertu.MSPCA, Rqt_Data_Par_SPCertu.MSPCSSAV, Rqt_Data_Par_SPCertu.MSPCASSAV, Rqt_Data_Par_SPCertu.CE, Rqt_Data_Par_Desig.Nom_Desig, Rqt_Data_Par_Desig.MD, Rqt_Data_Par_Desig.MDA, Rqt_Data_Par_Desig.MDSSAV, Rqt_Data_Par_Desig.MDASSAV, Rqt_Data_Par_Desig.CE, Rqt_Data_Par_Ressources.Nom_R, Rqt_Data_Par_Ressources.MR, Rqt_Data_Par_Ressources.MRA, Rqt_Data_Par_Ressources.MRSSAV, Rqt_Data_Par_Ressources.MRASSAV, Rqt_Data_Par_Ressources.CE, Rqt_Data_Par_PCertu.Longueur, Rqt_Data_Par_PCertu.Longueur_Travailler, Rqt_Data_Par_PCertu.GLO,"
sSQL = sSQL & " Rqt_Data_Par_PCertu.nb_Stations_simple , Rqt_Data_Par_PCertu.Nb_Stations_double, Rqt_Data_Par_PCertu.Capacite_SMR, Rqt_Data_Par_PCertu.Montant_BT, Rqt_Data_Par_PCertu.Montant_BT_Actu, Rqt_Data_Par_PCertu.Montant_BT_Sans_SAV, Rqt_Data_Par_PCertu.Montant_BT_Actu_Sans_SAV"
sSQL = sSQL & " HAVING ((" & IPT & ") AND (" & IC & "));"
 
    DoCmd.DeleteObject acQuery, "Rqt_Data_Regroupe_0_type"
    CurrentDb.CreateQueryDef "Rqt_Data_Regroupe_0_type", sSQL
 
Set xlapp = CreateObject("Excel.Application")
    xlapp.Visible = True
    xlapp.Workbooks.Open ("C:\Documents and Settings\stif\Mes documents\coût\base de données\Fiche Projet.xlsm")
    xlapp.Workbooks("Fiche Projet.xlsm").sheets("Data").Activate
 
xlapp.Close
Set xlapp = Nothing
 
Db.Close
Set Db = Nothing

Pouvez vous me dire ce qui ne va pas?

Merci

**AlainTech** · 29/02/2012, 08h12

Bonjour,

Si tu cliques sur Ok, l'opération continue-t-elle?
Si oui, j'ai un code quelque part qui permet d'attendre la fin de l'action sans montrer le message.

Je vais voir si j'ai le temps de le trouver aujourd'hui.

**rob1son76** · 29/02/2012, 10h20

Salut,

Oui quand je clic il se remet en marche mais un nouveau message réapparait.
Et ainsi de suite, J'ai arrêté l'exécution au bout de 5 messages.
Je pense que ca viens d'une de mes requêtes qui est très complexe.
Mais je veux bien ton code quand même. ^^

Merci

**AlainTech** · 29/04/2012, 22h26

Bonjour à tous,

Désolé pour le retard.

Voici:
http://www.developpez.net/forums/d82...l/#post4723580

Attention!
Si la requête n'aboutit jamais, ça va boucler sans arrêt.
Cette commande ne sert qu'à "cacher" le message OLE.
Il faut donc tester la requête pour savoir si elle aboutit après un (ou plusieurs) messages OLE.

message erreur: Microsoft office excel attend la fin de l'exécution d'une action OLE d'une autre application.

Macros et VBA Excel

Discussions similaires

Partager

Partager