application filtre puis extraction formulaire sous word

**kyser13** · 22/11/2008, 11h01

Bonsoir a tous,
je me permets de venir vers vous car j'ai un petit probleme.Je débute en VB et je dois optimiser une base de donnée access.
le principe : un formulaire déja existant me permet de générer un paquet ( 800 pages) de document word avec une mise en page un peu particulière.En fait cela me génére des procédures de test.

l'idée : la génération des documents prend 1H30 , je cherche donc a optimiser cela et j'avais l'intention d'utiliser des filtres pour effectuer des recherches plus cibler sur une procédure en particulier.

Questions:Comment intégrer mon filtre dans mon code ?
L'action filtre+ extraction peut elle se faire sur 1 seul et meme bouton?

Voici le code qui génère les 800 l'intégralité des tests:

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
Private Sub Commande_filtre_Click()
Dim Bd As Database
    Dim ListeToutlesTests, ListeToutlesExigencesParTest As Recordset
    Dim TypeParTest, ListeActionTypeParTest, ListeActionParTest As Recordset
    Dim ListeTests, ListeTests2, ListeTests3, ListeTests4, ListeTests5, ListeTests6, ListeTests7 As Recordset
    Dim ListeDescriptions As Recordset
    Dim ListeMoyens As Recordset
    Dim ListeLogiciels As Recordset
    Dim ListeFichiers As Recordset
    Dim SQLString As String
    Dim SQLString2, SQLString3, SQLString4, SQLString5, SQLString6, SQLString7 As String
    Dim SQLStringExigenceParTest, SQLStringActionTypeParTest, SQLStringtypeParTest, SQLStringActionParTest As String
    Dim Info As String
    Dim Sauv As String
    Dim NomSignet As String
    Dim NbRecordTest As Integer
    Dim NbRecordMateriel As Integer
    Dim NbRecordLogiciel As Integer
    Dim NbRecordFichier As Integer
 
    Dim longeur_boucle As Integer
 
 
    Dim WordApp As Object
    Dim ExcelApp As Object
    Dim i As Integer
    Dim j As Integer
    Dim k As Integer
    Dim l As Integer
    Dim m As Integer
 
    Dim t_clef, p_essai_clef, m_clef, c_essai_clef, t_id, t_phase, t_intitule, t_objectif, t_etatinitial, t_contexte, t_resok, t_okpartiel, t_nok As String
    Dim t_fournisseur, t_commentaire As String
 
    Dim t_date As String
    Dim t_essai_reg As Boolean
 
 
    Dim PauseTime, Start, Finish, TotalTime
 
 
 
    On Error Resume Next
 
       ' If (Me.Texte12 <> "" And Me.Texte12 <> "") Then
         '   Sauv = Me.Texte12 + "\" + Me.Texte12
       ' Else
            Sauv = "c:\Procedure_de_testbis.doc"
        'End If
        DoCmd.Close acForm, Me.Name
 
        Set WordApp = GetObject(, "Word.Application")
 
        If Err.Number <> 0 Then
            Err.Clear
            Set WordApp = CreateObject("Word.Application")
        End If
 
        WordApp.Visible = False
 
        PauseTime = 1   ' Définit la durée.
 
        WordApp.Documents.Add Template:="Normal", NewTemplate:=False, DocumentType:=0
        WordApp.ActiveDocument.SaveAs FileName:=Sauv, FileFormat:=0, LockComments:=False, Password:="", AddToRecentFiles:= _
                True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
                SaveAsAOCELetter:=False
 
        Set Bd = CurrentDb
 
        SQLString = "SELECT * from t_test"
        Set ListeToutlesTests = Bd.OpenRecordset(SQLString, dbOpenDynaset)
        ListeToutlesTests.MoveLast
        l = 0
 
        longeur_boucle = 0
        ListeToutlesTests.MoveFirst
 
       ' Do While Not longeur_boucle = 213
        'longeur_boucle = longeur_boucle + 1
       ' ListeToutlesTests.MoveNext
      '  Loop
        Do While Not ListeToutlesTests.EOF
 
        t_clef = ListeToutlesTests![T_TEST_CLEF]
        p_essai_clef = Str(ListeToutlesTests![T_PHASE_ESSAI_CLEF])
        m_clef = Str(ListeToutlesTests![T_METHODE_CLEF])
        c_essai_clef = Str(ListeToutlesTests![T_CLASSE_ESSAI_CLEF])
        t_id = ListeToutlesTests![T_TEST_ID]
        t_date = Str(ListeToutlesTests![T_TEST_DATE])
        t_phase = Str(ListeToutlesTests![T_TEST_PHASE])
        t_intitule = ListeToutlesTests![T_TEST_INTITULE]
        t_objectif = ListeToutlesTests![T_TEST_OBJECTIF]
        t_etatinitial = Str(ListeToutlesTests![T_TEST_ETATINITIAL])
        t_contexte = ListeToutlesTests![T_TEST_CONTEXTE]
        t_resok = Str(ListeToutlesTests![t_test_resok])
        t_okpartiel = Str(ListeToutlesTests![t_test_okpartiel])
        t_nok = Str(ListeToutlesTests![t_test_nok])
        t_fournisseur = Str(ListeToutlesTests![T_TEST_FOURNISSEUR])
        t_essai_reg = ListeToutlesTests![T_TEST_ESSAI_REG]
        t_commentaire = ListeToutlesTests![T_TEST_COMMENTAIRE]
 
        SQLStringExigenceParTest = "SELECT T_EXIGENCES_NIV3.T_EXIGENCES_NIV3_LIBELLE, T_EXIGENCES_NIV3.T_EXIGENCES_NIV3_REFERENCE"
        SQLStringExigenceParTest = SQLStringExigenceParTest + " FROM T_EXIGENCES_NIV3 INNER JOIN R_REPOND ON T_EXIGENCES_NIV3.T_EXIGENCES_NIV3_CLEF = R_REPOND.T_EXIGENCES_NIV3_CLEF"
        SQLStringExigenceParTest = SQLStringExigenceParTest + " WHERE (((R_REPOND.T_TEST_CLEF)=" + Str(t_clef) + "));"
        Set ListeToutlesExigencesParTest = Bd.OpenRecordset(SQLStringExigenceParTest, dbOpenDynaset)
 
 
        SQLStringtypeParTest = "SELECT T_PHASE_ESSAI.T_PHASE_ESSAI_CLEF, T_CLASSE_ESSAI.T_CLASSE_ESSAI_CLEF, T_METHODE.T_METHODE_CLEF, T_TEST.T_TEST_CLEF"
        SQLStringtypeParTest = SQLStringtypeParTest + " FROM T_CLASSE_ESSAI INNER JOIN (T_PHASE_ESSAI INNER JOIN (T_METHODE INNER JOIN T_TEST ON T_METHODE.T_METHODE_CLEF = "
        SQLStringtypeParTest = SQLStringtypeParTest + " T_TEST.T_METHODE_CLEF) ON T_PHASE_ESSAI.T_PHASE_ESSAI_CLEF = T_TEST.T_PHASE_ESSAI_CLEF) ON T_CLASSE_ESSAI.T_CLASSE_ESSAI_CLEF = T_TEST.T_CLASSE_ESSAI_CLEF"
        SQLStringtypeParTest = SQLStringtypeParTest + " WHERE (((T_TEST.T_TEST_CLEF)= " + Str(t_clef) + "));"
 
 
        Set TypeParTest = Bd.OpenRecordset(SQLStringtypeParTest, dbOpenDynaset)
        Dim IntPhaseEssai, IntClasseEssai, IntMethode As Integer
        IntPhaseEssai = TypeParTest![T_PHASE_ESSAI_CLEF]
        IntClasseEssai = TypeParTest![T_CLASSE_ESSAI_CLEF]
        IntMethode = TypeParTest![T_METHODE_CLEF]
 
 
 
 
        SQLStringActionTypeParTest = "select * from t_actions_type where t_test_clef = " + Str(t_clef) + ";"
        Set ListeActionTypeParTest = Bd.OpenRecordset(SQLStringActionTypeParTest, dbOpenDynaset)
        ListeActionTypeParTest.MoveLast
        Dim nbretypeaction, typeaction As Integer
        nbretypeaction = ListeActionTypeParTest.RecordCount
        'MsgBox Str(nbretypeaction), vbOKOnly
 
 
 
        NomSignet = Str(l)
            NomSignet = "P_4_" + Trim(NomSignet)
            WordApp.ActiveDocument.Bookmarks.Add (NomSignet)
            WordApp.ActiveDocument.Bookmarks.Item(l).DefaultSorting = 0
            WordApp.ActiveDocument.Bookmarks.Item(l).ShowHidden = False
 
            WordApp.ActiveDocument.Tables.Add Range:=WordApp.Selection.Range, NumRows:=5, NumColumns:= _
                4, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
                wdAutoFitFixed
            longeur_boucle = longeur_boucle + 1
            With WordApp.Selection.Tables(1)
                If WordApp.Style <> "Grille du tableau" Then
                    WordApp.Style = "Grille du tableau"
                End If
                WordApp.ApplyStyleHeadingRows = True
                WordApp.ApplyStyleLastRow = True
                WordApp.ApplyStyleFirstColumn = True
                WordApp.ApplyStyleLastColumn = True
            End With
 
            WordApp.Selection.MoveRight Count:=4, extend:=1
 
 
 
            WordApp.Selection.ParagraphFormat.Alignment = 1
            ' WordApp.Selection.Cells.Width = 5
            'WordApp.Selection.Tables(1).Columns(1).SetWidth ColumnWidth:=WordApp.CentimetersToPoints(12), RulerStyle:=0
            '  WordApp.Selection.Cells.SetWidth ColumnWidth:=WordApp.CentimetersToPoints(12), RulerStyle:=0
 
 
            WordApp.Selection.MoveRight Count:=1
            'WordApp.Selection.MoveRight Count:=1, Extend:=1
            WordApp.Selection.Cells.SetWidth ColumnWidth:=WordApp.CentimetersToPoints(2), RulerStyle:=0
            WordApp.Selection.Shading.BackgroundPatternColor = 15987699
            WordApp.Selection.Font.Bold = True
            WordApp.Selection.TypeText Text:="H Gén"
 
            With WordApp.Selection.Borders(-5)
                .LineStyle = WordApp.Options.DefaultBorderLineStyle
                .LineWidth = WordApp.Options.DefaultBorderLineWidth
                .Color = WordApp.Options.DefaultBorderColor
            End With
            With WordApp.Selection.Borders(-6)
                .LineStyle = WordApp.Options.DefaultBorderLineStyle
                .LineWidth = WordApp.Options.DefaultBorderLineWidth
                .Color = WordApp.Options.DefaultBorderColor
            End With
            WordApp.Selection.Rows.HeadingFormat = True
            WordApp.Selection.InsertRowsBelow 1
            WordApp.Selection.Rows.HeadingFormat = False
            WordApp.Selection.Cells.Merge
            WordApp.Selection.Font.Color = -16777216
            WordApp.Selection.Font.Bold = True
            WordApp.Selection.TypeText Text:="EXIGENCE(S) A VERIFIER :"
 
            WordApp.Selection.ParagraphFormat.Alignment = 1
            WordApp.Selection.InsertRowsBelow 1
            WordApp.Selection.Cells.Split NumRows:=1, NumColumns:=2, MergeBeforeSplit:=True
            WordApp.Selection.TypeText Text:="REFERENCE"
            WordApp.Selection.MoveRight Count:=1
            WordApp.Selection.TypeText Text:="LIBELLE"
            Dim NbreRef, Ref As Integer
            Dim Strlib, StrRef As String
            NbreRef = 0
            ListeToutlesExigencesParTest.MoveLast
            Ref = ListeToutlesExigencesParTest.RecordCount
            ListeToutlesExigencesParTest.MoveFirst
 
            Do While (NbreRef < Ref)
                Strlib = ListeToutlesExigencesParTest![T_EXIGENCES_NIV3_LIBELLE]
                StrRef = 
 
            WordApp.Selection.TypeText Text:="PHASE D'ESSAI"
            WordApp.Selection.MoveRight Count:=1
            WordApp.Selection.TypeText Text:="CLASSE D'ESSAI"
            WordApp.Selection.MoveRight Count:=1
            WordApp.Selection.TypeText Text:=" METHODE"
 
            ' creation des checkbox
            WordApp.Selection.InsertRowsBelow 1
            WordApp.Selection.Shading.BackgroundPatternColor = -16777216
            With WordApp.Selection.FormFields.Add(Range:=WordApp.Selection.Range, Type:=71)
                    If IntPhaseEssai = 1 Then
                        .CheckBox.Value = True
                    Else
                        .CheckBox.Value = False
                    End If
            End With
            WordApp.Selection.ParagraphFormat.Alignment = 0
            WordApp.Selection.Font.Bold = False
            WordApp.Selection.TypeText Text:="INTEGRATION"
            WordApp.Selection.MoveRight Count:=1
 
            With WordApp.Selection.FormFields.Add(Range:=WordApp.Selection.Range, Type:=71)
                    If IntClasseEssai = 1 Then
                        .CheckBox.Value = True
                    Else
                        .CheckBox.Value = False
                    End If
            End With
            WordApp.Selection.Font.Bold = False
            WordApp.Selection.ParagraphFormat.Alignment = 0
            WordApp.Selection.TypeText Text:="FONCTIONNEL"
            WordApp.Selection.MoveRight Count:=1
 
 
            With WordApp.Selection.FormFields.Add(Range:=WordApp.Selection.Range, Type:=71)
                    If IntMethode = 1 Then
                        .CheckBox.Value = True
                    Else
                        .CheckBox.Value = False
                    End If
            End With
            WordApp.Selection.Font.Bold = False
            WordApp.Selection.ParagraphFormat.Alignment = 0
            WordApp.Selection.TypeText Text:="INSPECTION"
            WordApp.Selection.InsertRowsBelow 1
 
 
            With WordApp.Selection.FormFields.Add(Range:=WordApp.Selection.Range, Type:=71)
                    If IntPhaseEssai = 2 Then
                        .CheckBox.Value = True
                    Else
                        .CheckBox.Value = False
                    End If
            End With
            WordApp.Selection.Font.Bold = False
            WordApp.Selection.TypeText Text:="QUALIFICATION"
            WordApp.Selection.MoveRight Count:=1
 
 
            With WordApp.Selection.FormFields.Add(Range:=WordApp.Selection.Range, Type:=71)
                    If IntClasseEssai = 2 Then
                        .CheckBox.Value = True
                    Else
                        .CheckBox.Value = False
                    End If
            End With
            WordApp.Selection.Font.Bold = False
            WordApp.Selection.TypeText Text:="ROBUSTESSE"
            WordApp.Selection.MoveRight Count:=1
 
 
 
            With WordApp.Selection.FormFields.Add(Range:=WordApp.Selection.Range, Type:=71)
                    If IntMethode = 2 Then
                        .CheckBox.Value = True
                    Else
                        .CheckBox.Value = False
                    End If
            End With
 
            WordApp.Selection.Font.Bold = False
            WordApp.Selection.TypeText Text:="ANALYSE"
            WordApp.Selection.InsertRowsBelow 1
 
 
            With WordApp.Selection.FormFields.Add(Range:=WordApp.Selection.Range, Type:=71)
                    If IntPhaseEssai = 3 Then
                        .CheckBox.Value = True
                    Else
                        .CheckBox.Value = False
                    End If
            End With
            WordApp.Selection.Font.Bold = False
            WordApp.Selection.TypeText Text:="ACCEPTATION"
            WordApp.Selection.MoveRight Count:=1
 
            With WordApp.Selection.FormFields.Add(Range:=WordApp.Selection.Range, Type:=71)
                    If IntClasseEssai = 3 Then
                        .CheckBox.Value = True
                    Else
                        .CheckBox.Value = False
                    End If
            End With
            WordApp.Selection.Font.Bold = False
            WordApp.Selection.TypeText Text:="PERFORMANCE"
            WordApp.Selection.MoveRight Count:=1
 
 
            With WordApp.Selection.FormFields.Add(Range:=WordApp.Selection.Range, Type:=71)
                    If IntMethode = 3 Then
                        .CheckBox.Value = True
                    Else
                        .CheckBox.Value = False
                    End If
            End With
 
            WordApp.Selection.Font.Bold = False
            WordApp.Selection.TypeText Text:="TEST"
 
            WordApp.Selection.InsertRowsBelow 1
            WordApp.Selection.Moveleft Count:=1
            WordApp.Selection.MoveRight Count:=2
            With WordApp.Selection.FormFields.Add(Range:=WordApp.Selection.Range, Type:=71)
                    If IntMethode = 4 Then
                        .CheckBox.Value = True
                    Else
                        .CheckBox.Value = False
                    End If
            End With
            WordApp.Selection.Font.Bold = False
 
            WordApp.Selection.TypeText Text:="DEMONSTRATION"
 
            WordApp.Selection.InsertRowsBelow 1
            WordApp.Selection.Shading.BackgroundPatternColor = 15987699
            WordApp.Selection.Cells.Merge
            WordApp.Selection.ParagraphFormat.Alignment = 1
            WordApp.Selection.TypeText Text:="ETAT INITIAL"
 
            WordApp.Selection.InsertRowsBelow 1
            WordApp.Selection.TypeText Text:="ESSAI DE NON REGRESSION"
            With WordApp.Selection.FormFields.Add(Range:=WordApp.Selection.Range, Type:=71)
                    If t_essai_reg = True Then
                        .CheckBox.Value = True
                    Else
                        .CheckBox.Value = False
                    End If
            End With
 
            WordApp.Selection.InsertRowsBelow 1
            WordApp.Selection.ParagraphFormat.Alignment = 0
            WordApp.Selection.Font.Bold = False
            WordApp.Selection.TypeText Text:="MISE EN ŒUVRE / CONTEXTE"
 
            WordApp.Selection.InsertRowsBelow 1
            WordApp.Selection.Font.Bold = False
            WordApp.Selection.Font.Color = 8388608
            WordApp.Selection.Shading.BackgroundPatternColor = -16777216
            WordApp.Selection.TypeText Text:=t_contexte
 
            WordApp.Selection.InsertRowsBelow 1
            WordApp.Selection.Shading.BackgroundPatternColor = 15987699
            WordApp.Selection.Font.Color = False
            WordApp.Selection.ParagraphFormat.Alignment = 1
            WordApp.Selection.Font.Bold = True
            WordApp.Selection.TypeText Text:="DESIGNATION DES DISPOSITIFS DE MESURE ET DE TEST ET VERSION"
 
            WordApp.Selection.InsertRowsBelow 1
            WordApp.Selection.ParagraphFormat.Alignment = 0
            WordApp.Selection.Font.Bold = False
 
            WordApp.Selection.InsertRowsBelow 1
            WordApp.Selection.ParagraphFormat.Alignment = 1
            WordApp.Selection.Font.Bold = True
            WordApp.Selection.TypeText Text:="COMMENTAIRES"
 
            WordApp.Selection.InsertRowsBelow 1
            WordApp.Selection.ParagraphFormat.Alignment = 0
            WordApp.Selection.Font.Bold = False
            WordApp.Selection.Font.Color = 8388608
            WordApp.Selection.Shading.BackgroundPatternColor = -16777216
            WordApp.Selection.TypeText Text:=t_commentaire
 
 
 
            WordApp.Selection.InsertRowsBelow 1
            WordApp.Selection.Shading.BackgroundPatternColor = 15987699
            WordApp.Selection.Font.Color = False
            WordApp.Selection.Font.Bold = True
            WordApp.Selection.ParagraphFormat.Alignment = 1
            WordApp.Selection.Cells.Split NumRows:=1, NumColumns:=3, MergeBeforeSplit:=True
            WordApp.Selection.Moveleft Count:=1
            WordApp.Selection.MoveRight Count:=1, extend:=1
            WordApp.Selection.Cells.SetWidth ColumnWidth:=WordApp.CentimetersToPoints(2), RulerStyle:=0
            WordApp.Selection.TypeText Text:="N°"
 
            WordApp.Selection.MoveRight Count:=1
            WordApp.Selection.MoveRight Count:=1, extend:=1
            WordApp.Selection.ParagraphFormat.Alignment = 1
            WordApp.Selection.Cells.SetWidth ColumnWidth:=WordApp.CentimetersToPoints(7.03), RulerStyle:=0
            WordApp.Selection.TypeText Text:="Description Des Actions"
 
            WordApp.Selection.MoveRight Count:=1
            WordApp.Selection.MoveRight Count:=1, extend:=1
            WordApp.Selection.ParagraphFormat.Alignment = 1
            WordApp.Selection.Cells.SetWidth ColumnWidth:=WordApp.CentimetersToPoints(7.03), RulerStyle:=0
            WordApp.Selection.TypeText Text:="Résultat Attendu"
 
            typeaction = 0
            Dim nbreaction, action, action_totale, ligne_act As Integer
            Dim actionnum, actiondescrp, actionresatt, actionresobs As String
            Dim typeactionnum, typeactionnom As String
            action_totale = 0
            ListeActionTypeParTest.MoveFirst
            Do While (typeaction < nbretypeaction)
 
                SQLStringActionParTest = "select * from t_actions where t_actions_type_clef =" + Str(ListeActionTypeParTest(0)) + ";"
                Set ListeActionParTest = Bd.OpenRecordset(SQLStringActionParTest, dbOpenDynaset)
                ListeActionParTest.MoveLast
                nbreaction = ListeActionParTest.RecordCount
                action_totale = action_totale + 1 + nbreaction
                typeaction = typeaction + 1
                ListeActionTypeParTest.MoveNext
 
            Loop
            ligne_act = 0
            Do While (ligne_act < (action_totale))
 
                WordApp.Selection.Font.Bold = False
                WordApp.Selection.Font.Color = 8388608
                WordApp.Selection.InsertRowsBelow 1
                ligne_act = ligne_act + 1
                WordApp.Selection.Shading.BackgroundPatternColor = -16777216
            Loop
            'MsgBox Str(action_totale), vbOKOnly
            WordApp.Selection.Moveup Count:=(action_totale - 1)
            ListeActionTypeParTest.MoveFirst
            typeaction = 0
            Do While (typeaction < nbretypeaction)
                typeactionnum = Str(ListeActionTypeParTest(2))
                typeactionnom = ListeActionTypeParTest(3)
                WordApp.Selection.TypeText Text:=typeactionnum
                WordApp.Selection.MoveRight Count:=1
                WordApp.Selection.MoveRight Count:=3, extend:=1
                WordApp.Selection.Cells.Merge
                WordApp.Selection.TypeText Text:=typeactionnom
                action = 0
                SQLStringActionParTest = "select * from t_actions where t_actions_type_clef =" + Str(ListeActionTypeParTest(0)) + ";"
                Set ListeActionParTest = Bd.OpenRecordset(SQLStringActionParTest, dbOpenDynaset)
                ListeActionParTest.MoveLast
                nbreaction = ListeActionParTest.RecordCount
                WordApp.Selection.EndKey Unit:=5
                WordApp.Selection.MoveRight Count:=1
 
                ListeActionParTest.MoveFirst
 
                Do While (action < nbreaction)
                 actiondescrp = ListeActionParTest(2)
                 actionresatt = ListeActionParTest(3)
                 actionresobs = ListeActionParTest(4)
                 actionnum = ListeActionParTest(5)
                 'WordApp.ApplyStyleHeadingRows = False
                 WordApp.Selection.TypeText Text:=actionnum
                 WordApp.Selection.MoveRight Count:=1
                 WordApp.Selection.TypeText Text:=actiondescrp
                 WordApp.Selection.MoveRight Count:=1
                 WordApp.Selection.TypeText Text:=actionresatt
                 WordApp.Selection.EndKey Unit:=5
                 WordApp.Selection.MoveRight Count:=1
                 action = action + 1
                ListeActionParTest.MoveNext
                Loop
 
                typeaction = typeaction + 1
                ListeActionTypeParTest.MoveNext
 
            Loop
            ListeActionTypeParTest.Close
           WordApp.Selection.EndKey Unit:=5
           WordApp.Selection.MoveRight Count:=2
           ' WordApp.Selection.InsertBreak Type:=7
            WordApp.Selection.InsertBreak Type:=2
            WordApp.Selection.EndKey Unit:=6
 
        ListeToutlesTests.MoveNext
        'WordApp.ActiveDocument.Save
        Loop
        ListeToutlesTests.Close
        MsgBox "Génération terminée", vbOKOnly
        WordApp.Visible = True
        WordApp.ActiveDocument.Save
 
                  DoCmd.Close acForm, Me.Name
            '  End If
End Sub
 
------------------------------------------------
Pour mon filtre je cherches a filtrer sur 4 criéteres pour le moment et je pensais a ce code
 
f = ""
If Not IsNull(Me.RMETHODE) And Me.RMETHODE <> "" Then
f = "T_METHODE_DESIGNATION  LIKE ""*" & Me.RMETHODE & "*"""
End If
If Not IsNull(Me.RLIBELLE) And Me.RLIBELLE <> "" Then
f = "T_EXIGENCES_NIV3_DESIGNATION  LIKE ""*" & Me.RLIBELLE & "*"""
End If
If Not IsNull(Me.RPHASEESSAI) And Me.RPHASEESSAI <> "" Then
If f <> "" Then
f = f & " AND T_PHASE_ESSAI_DESIGNATION ""*" & Me.RPHASEESSAI & "*"""
Else
f = "AND T_PHASE_ESSAI_DESIGNATION LIKE ""*" & Me.RPHASEESSAI & "*"""
End If
End If
If Not IsNull(Me.RCLASSEESSAI) And Me.RCLASSEESSAI <> "" Then
f = "T_CLASSE_ESSAI_DESIGNATION LIKE ""*" & Me.RCLASSEESSAI & "*"""
End If
 
Me.Filter = f
Me.FilterOn = True
On Error GoTo Err_Commande_filtre_Click
 
 
    DoCmd.RunCommand acCmdApplyFilterSort
 
Exit_Commande_filtre_Click:
    Exit Sub
 
Err_Commande_filtre_Click:
    MsgBox Err.Description
    Resume Exit_Commande_filtre_Click
 
End Sub
 
----------------------------------------------------------------------------------

J'espere que mon probleme est clair pour tout le monde et j'espere avoir des retours sur mes problemes.
Merci pour les éventuelles réponses

**OhMonBato** · 22/11/2008, 13h13

J'avoue n'avoir que survole ton code, et encore, a haute altitude...
Je me demande quand meme si dans le principe, tu ne ferais pas mieux d'avoir des documents modeles (.dot) avec quelques signets ou champs que tu remplirais ensuite en fonction de tes cas, plutot que de recreer a chaque fois un document Word de A a Z.
Il y aurait sans doute un gain de temps et surement un gain de lisibilite de ton code.

**kyser13** · 22/11/2008, 13h56

Merci tout d'abord d'avoir répondu a ce message !
je vais me renseigner d'avantages sur ce que tu me conseil car je ne suis pas un grand spécialiste de VB et si tu dis que cela rendra mon code plus visible je vais essayer alors !

Merci

application filtre puis extraction formulaire sous word

VB 6 et antérieur

Discussions similaires

Partager

Partager