je passe par excel pour programmer sous forme de publipostage des fichiers Word. le probleme est qu'avec ma macro quand j'ai de la chance ma boite de dialogue s'affiche et j'enregistre correctement mes fichiers word et quand j'ai pas de chance la macro ce plante et tourne sans jamais ouvrir la boite de dialogue. je ne comprend absolument rien à ce phénomène. voici la macro en question :

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
Private Sub CommandButton1_Click()
 
    Dim WordApp As Object, WordDoc As Object
    Const wdDialogFileSaveAs = 84
    Dim Fichier As String, Titre As String
    Dim i As Byte, Lign As Byte, NbLign As Byte, Cel As Byte, NvLign As Byte
    Dim nbpage As Byte, cptpage As Byte
 
    Application.DisplayAlerts = False
    Lign = 21
    While (ActiveSheet.Cells(Lign, 1) <> "")
        Lign = Lign + 1
    Wend
 
    Titre = "Transmission Réclam KX " & TextBox1 & " du " & Format(TextBox2, "dd mm yyyy")
 
    repertoir = Environ("HOMEPATH") & "\"
    If Lign = 21 Then
           'Adhérent Unique
           Fichier = "C:\macros\Production\corporate\Décès Collectif\Transmission Réclam KX\model\transrclkxuniq.doc"
 
           If Dir(Fichier) <> "" Then
               Set WordApp = CreateObject("word.application")
               Set WordDoc = WordApp.Documents.Open(Fichier)
 
               For i = 1 To 14
                   If i = 6 Then
                       dform = Cells(6, i)
                       madate = Format(dform, "dd mmmm yyyy")
                       WordDoc.Bookmarks("Signet" & i).Range.Text = madate
                   ElseIf i = 8 Then
                       dform = Cells(6, i)
                       nombr = Format(dform, "#,0")
                       WordDoc.Bookmarks("Signet" & i).Range.Text = nombr
                   Else
                       WordDoc.Bookmarks("Signet" & i).Range.Text = Cells(6, i)
                   End If
               Next i
 
           Else
               MsgBox "Fichier introuvable"
               End
           End If
 
    ElseIf Lign > 21 Then
 
            'Adhérents Multiples
            Fichier = "C:\macros\Production\corporate\Décès Collectif\Transmission Réclam KX\model\transrclkxmulti.doc"
 
            If Dir(Fichier) <> "" Then
                Set WordApp = CreateObject("word.application")    'ouvre une session Word
                Set WordDoc = WordApp.Documents.Open(Fichier)
 
                For i = 1 To 12
                    If i = 6 Then
                       dform = Cells(17, i)
                       madate = Format(dform, "dd mmmm yyyy")
                       WordDoc.Bookmarks("Signet" & i).Range.Text = madate
                   ElseIf i = 8 Then
                       dform = Cells(17, i)
                       nombr = Format(dform, "#,0")
                       WordDoc.Bookmarks("Signet" & i).Range.Text = nombr
                    Else
                       WordDoc.Bookmarks("Signet" & i).Range.Text = Cells(17, i)
                   End If
                Next i
 
                'Gestion du tableau
                NbLign = Lign - 21
                NvLign = 21
                y = 1
                For Cel = 2 To (NbLign + 1)
                    WordDoc.Tables(1).Rows.Add
                    WordDoc.Tables(1).Columns(1).Cells(Cel).Range.Text = y
                    WordDoc.Tables(1).Columns(2).Cells(Cel).Range.Text = Range("A" & NvLign)
                    NvLign = NvLign + 1
                    y = y + 1
                Next Cel
                WordDoc.Tables(1).Rows(1).shading.backgroundpatterncolor = RGB(160, 160, 160)
                WordDoc.Tables(1).Columns(1).shading.backgroundpatterncolor = RGB(160, 160, 160)
                WordDoc.Tables(1).Rows(1).HeadingFormat = True
 
                'Vide la liste des adhérents
                Range("A21:A" & (Lign - 1)).ClearContents
 
            Else
                MsgBox "Fichier introuvable"
                End
            End If
    End If
 
    'Affiche la boite dialogue de sauvegarde avec la pre-saisie de la réf 
    With WordApp.Dialogs(wdDialogFileSaveAs)
         .Name = repertoir & Titre & ".doc"
         .Show
    End With
 
    WordApp.Visible = True    'affiche le document Word
    Unload Me
 
End Sub