Générer un tableau word variable en cellule et en ligne à partir d'une macro Excel et le renseigner

Version imprimable

Salut, j'ai un grand souci sur la macro que je dois mettre en place et je suis complètement bloqué.

j'utilise ce code sur Excel pour générer et enregistrer à partir d'un model, un courrier word.

Code:

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
 
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
    Dim cfichier As New Scripting.FileSystemObject
 
    'Application.DisplayAlerts = False
    Fichier = "D:\macros\Production\Bancassurance\Courrier\TransmissTest.docx"
 
    Titre = "BIA Accèpté de " & TextBox1 & " du " & Format(TextBox2, "dd-mm-yyyy")
    'MsgBox Titre
    If cfichier.FileExists("D:\macros\Production\Bancassurance\Copies\" & Titre & ".docx") Then
        MsgBox "Ce nom de fichier existe déjà, veuillez essayer un autre nom!"
        End
    End If
 
    cfichier.CopyFile Fichier, "D:\macros\Production\Bancassurance\Copies\" & Titre & ".docx", True 'False
    'False
    FichierCopie = "D:\macros\Production\Bancassurance\Copies\" & Titre & ".docx"
    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 20
            If i = 5 Then
                dform = Cells(2, i)
                madate = Format(dform, "dd mmmm yyyy")
                WordDoc.Bookmarks("Signet" & i).Range.Text = madate
            ElseIf i = 9 Then
                dform = Cells(2, i)
                nombr = Format(dform, "#,0")
                WordDoc.Bookmarks("Signet" & i).Range.Text = nombr
                Else
                WordDoc.Bookmarks("Signet" & i).Range.Text = Cells(2, i)
            End If
        Next i
 
        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
    Else
        MsgBox "Fichier introuvable"
        End
    End If
 
    Unload Me
 
End Sub

ceci marche très bien cependant, j'aimerai en annexe pouvoir ajouter un tableau récapitulatif.

lorsque ce tableau présente une seule ligne le code si dessus marche bien j'y insère les signet et GO, mais lorsque le tableau varie en nombre de ligne (>1) je suis complètement bloqué et j'ai besoin d'aide.

Le probleme de ce tableau vien du fait qu'il est dynamique, en fonction du nombre de ligne renseignées dans Excel.

Bonjour,

Je n'ai pas le temps, et probablement pas avant demain de bâtir un bout de code, mais voici les informations qui devraient te mettre sur la voie.

En ajoutant la référence à Microsoft Wordxx Library, en plus, ou même au lieu, de CreateObject, tu as accès à l'aide et à l'IntelliSense de VBA Word, directement à partir de VBA Excel.

Dans Word, il y a l'objet Table pour désigner un tableau et la collection Tables() pour regrouper les tableaux :

On ajoute un tableau dans le document avec la méthode tables.add.

Voici deux exemples tirés de l'aide de VBA Word, à adapter pour la position et le pilotage par automation.
Citation:
Exemple

Cet exemple montre comment ajouter un tableau vide de trois lignes sur quatre colonnes au début du document actif.

Visual Basic pour Applications
Set myRange = ActiveDocument.Range(0, 0)
ActiveDocument.Tables.Add Range:=myRange, NumRows:=3, NumColumns:=4

Cet exemple montre comment ajouter un nouveau tableau vide de six lignes sur dix colonnes à la fin du document actif.

Visual Basic pour Applications
Code:

1 2 3 4 Set MyRange = ActiveDocument.Content MyRange.Collapse Direction:=wdCollapseEnd ActiveDocument.Tables.Add Range:=MyRange, NumRows:=6, _ NumColumns:=10
Cet exemple montre comment ajouter un tableau de trois lignes sur cinq colonnes dans un nouveau document, puis comment insérer des données dans chaque cellule du tableau.

Visual Basic pour Applications
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 Sub NewTable() Dim docNew As Document Dim tblNew As Table Dim intX As Integer Dim intY As Integer Set docNew = Documents.Add Set tblNew = docNew.Tables.Add(Selection.Range, 3, 5) With tblNew For intX = 1 To 3 For intY = 1 To 5 .Cell(intX, intY).Range.InsertAfter "Cell: R" & intX & ", C" & intY Next intY Next intX .Columns.AutoFit End With End Sub
Si tu ajoutes la référence à Word, il va te suffire de cliquer sur Table et "F1Tiser" (appuyer sur :f1: ) pour te faire demander de choisir entre une Table Excel et une Table Word.

26/03/2015, 09h04
saninx

Salut, quand je déclare un objet table ("Dim WTbl as Table") on me remmène une ERREUR type non définit .

J'essais a partir d'une macro sur Excel d'ajouter des lignes et des colonnes à un tableau dont l'entête est déjà présent sur Word et y insérer des éléments contenu dans un tableau sur le fichier Excel.

Venez moi en aide , j'en ai urgemment besoin.
26/03/2015, 19h12
clementmarcotte

1 pièce(s) jointe(s)

Essaie avec :

Code:

Dim WTbl as word.Table

Ce n'est pas pour rien que j'avais mis cela dans ma réponse précédente:

Citation:

Voici deux exemples tirés de l'aide de VBA Word, à adapter pour la position et le pilotage par automation.

et que j'ai terminé avec cela:

Citation:

Si tu ajoutes la référence à Word, il va te suffire de cliquer sur Table et "F1Tiser" (appuyer sur ) pour te faire demander de choisir entre une Table Excel et une Table Word.

:aie:

Ah, et puis tiens, je me suis laissé attendrir.

Ne pas revenir me hanter si tu n'as pas pris le temps d'ajouter la Référence à Word, dans Outils - Références

Merci à tous pour vos aides, j'ai trouvé la solution à mon problème

Pour tous ceux qui voudront s'en inspirer :

Code:

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
 
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 cfichier As New Scripting.FileSystemObject
 
    'Application.DisplayAlerts = False
    Lign = 21
    While (ActiveSheet.Cells(Lign, 1) <> "")
        Lign = Lign + 1
    Wend
 
    If Lign = 21 Then
           'Adhérent Unique
           Fichier = "D:\macros\Production\Bancassaurance1\Model\ModelUnique.doc"
 
           Titre = "BIA Accèpté de " & TextBox1 & " du " & Format(TextBox2, "dd-mm-yyyy")
           'MsgBox Titre
           If cfichier.FileExists("D:\macros\Production\Bancassaurance1\Copies\" & Titre & ".doc") Then
               MsgBox "Ce nom de fichier existe déjà, veuillez essayer un autre nom!"
               End
           End If
 
           cfichier.CopyFile Fichier, "D:\macros\Production\Bancassaurance1\Copies\" & Titre & ".doc", True 'False
           'False
           FichierCopie = "D:\macros\Production\Bancassaurance1\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 25
                   If i = 5 Or i = 14 Then
                       dform = Cells(6, i)
                       madate = Format(dform, "dd mmmm yyyy")
                       WordDoc.Bookmarks("Signet" & i).Range.Text = madate
                   ElseIf i = 8 Or i = 20 Or i = 21 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 = "D:\macros\Production\Bancassaurance1\Model\ModelMulti.doc"
 
            Titre = "BIA Accèpté de " & TextBox1 & " du " & Format(TextBox2, "dd-mm-yyyy")
            'MsgBox Titre
            If cfichier.FileExists("D:\macros\Production\Bancassaurance1\Copies\" & Titre & ".doc") Then
                MsgBox "Ce nom de fichier existe déjà, veuillez essayer un autre nom!"
                End
            End If
 
            cfichier.CopyFile Fichier, "D:\macros\Production\Bancassaurance1\Copies\" & Titre & ".doc", True 'False
            'False
            FichierCopie = "D:\macros\Production\Bancassaurance1\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 18
                    If i = 5 Or i = 14 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
                For Cel = 2 To (NbLign + 1)
                    WordDoc.tables(1).Rows.Add
                    WordDoc.tables(1).Columns(1).Cells(Cel).Range.Text = Range("A" & NvLign)
                    WordDoc.tables(1).Columns(2).Cells(Cel).Range.Text = Range("B" & NvLign)
                    WordDoc.tables(1).Columns(3).Cells(Cel).Range.Text = Range("C" & NvLign)
                    WordDoc.tables(1).Columns(4).Cells(Cel).Range.Text = Format(Range("D" & NvLign), "#,0")
                    WordDoc.tables(1).Columns(5).Cells(Cel).Range.Text = Format(Range("E" & NvLign), "#,0")
                    NvLign = NvLign + 1
                Next Cel
                WordDoc.tables(1).Rows(1).shading.backgroundpatterncolor = RGB(160, 160, 160)
 
            Else
                MsgBox "Fichier introuvable"
                End
            End If
            Range("A21:E" & (Lign - 1)).ClearContents
 
    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
 
End Sub