Discussion :

[saninx]

Salut, j'ai un soucis avec ma macro.

celle-ci renvoi des valeurs de plusieurs cellules excel sur un ficher word. cependant au niveau de la cellulle (cells(6, 7)) elle me renvoi l'erreur 13.
je ne vois vraiment pas l'erreur vu que j'utilise cette technique pour automatiser mes courriers word depuis un bout de temps.

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
 
 
Private Sub CommandButton1_Click()
 
    Dim WordApp As Object, WordDoc As Object
    Dim Fichier As String, FichierCopie 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
    Dim cfichier As New Scripting.FileSystemObject
 
    Application.DisplayAlerts = False
    Lign = 21
    While (ActiveSheet.Cells(Lign, 1) <> "")
        Lign = Lign + 1
    Wend
 
    Titre = "Transmission Avt N° " & TextBox1 & " du " & Format(TextBox2, "dd mm yyyy")
    If cfichier.FileExists("C:\macros\Production\corporate\word\transmisBiaAcp\copies\" & Titre & ".doc") Then
               MsgBox "Ce nom de fichier existe déjà, veuillez essayer un autre nom!"
               End
    End If
 
    If Lign = 21 Then
           'Adhérent Unique
           Fichier = "C:\macros\Production\corporate\word\transmisBiaAcp\model\transbiaaptuniq.doc"
           cfichier.CopyFile Fichier, "C:\macros\Production\corporate\word\transmisBiaAcp\copies\" & Titre & ".doc", True 'False
           'False
           FichierCopie = "C:\macros\Production\corporate\word\transmisBiaAcp\copies\" & Titre & ".doc"
           Set cfichier = Nothing
 
           If Dir(Fichier) <> "" Then
               Set WordApp = CreateObject("word.application")
               Set WordDoc = WordApp.Documents.Open(FichierCopie)
 
               For i = 1 To 17
                   If i = 2 Then
                       If Cells(6, i) = 0 Then
                           WordDoc.Bookmarks("Signet" & i).Range.Text = ""
                       End If
                   ElseIf 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\word\transmisBiaAcp\model\transbiaaptmulti.doc"
            cfichier.CopyFile Fichier, "C:\macros\Production\corporate\word\transmisBiaAcp\copies\" & Titre & ".doc", True 'False
            'False
            FichierCopie = "C:\macros\Production\corporate\word\transmisBiaAcp\copies\" & Titre & ".doc"
            Set cfichier = Nothing
 
            If Dir(Fichier) <> "" Then
                Set WordApp = CreateObject("word.application")    'ouvre une session Word
                Set WordDoc = WordApp.Documents.Open(FichierCopie)
 
                For i = 1 To 15
                    If i = 2 Then
                       If Cells(6, i) = 0 Then
                           WordDoc.Bookmarks("Signet" & i).Range.Text = ""
                       End If
                   ElseIf 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
 
                '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
 
    WordDoc.Save
    WordApp.Visible = True    'affiche le document Word
    'WordDoc.PrintOut          'Pour imprimer le doc obtenu
    'WordDoc.Close True        'ferme le document word en sauvegardant les données
    'WordApp.Quit              'ferme la session Word
    Unload Me
    MsgBox ("Courrier générer avec succès !")
 
End Sub
 
Private Sub TextBox1_Change()
    TextBox2.Value = Date
End Sub

elle ramène l'erreur au niveau de cette ligne

Code :

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

1
2
 
WordDoc.Bookmarks("Signet" & i).Range.Text = Cells(6, i)

Merci de bien vouloir mevenir en aide

[saninx]

au fait mon code est parfait , j'avais juste des cellules masquée qui perturbaient mon programme.

solution trouvée