Remplacer signet word par tableau Excel

Le 17/05/2021 à 12:55

Bonjour à tous,

Je cherche à remplir une trame de compte rendu à partir d'une feuille excel où je fais tous mes calculs pour ce compte rendu. Je souhaite donc récupérer des valeurs et tableaux de ma feuille excel pour les exporter dans un document word.

J'arrive à remplacer les signets par des valeurs de cellules, mais je n'arrive pas à les remplacer par des tableaux. Pour le moment, la seule solution que j'ai pour implémenter mes tableaux est de passer par la fonction copy et past de vba mais cela ne me convient pas. Pour moi l'idéal c'est que le signet soit remplacer par un tableau.

Je comprend la mécanique pour des cellules simple, mais je ne sais pas comment adapter mon code pour y faire entre un tableau. J'utilise ce morceau de code pour remplacer un signet par une valeur de cellule :

WordDoc.Bookmarks("AgeDépart").Range.Text = Worksheets("Client").Cells(15, 2)

La base du code que j'utilise, je l'ai trouvé sur internet, dedans il y a ce bout de code :

            ' s'il y a un tableau dans le doc word
            With WordDoc.Tables(1)
                ' ajoute le contenu de C2 dans la cellule ligne 2 colonne 2 du tableau word
                Sheets("Client").cell(2, 2).Range.InsertAfter ActiveSheet.Range("C2").Value
                ' ajoute le contenu de D2 dans la cellule ligne 2 colonne 3 du tableau word
                Sheets("Client").cell(2, 3).Range.InsertAfter ActiveSheet.Range("D2").Value
                ' ...
            End With

mais je ne le comprend pas (et il ne fonctionne pas dans mon cas bien qu'il y est un tableau dans ma trame).

Je cherche sur internet comment faire depuis ce matin, et ce que je trouve je n'arrive pas à l'appliquer à mon code.

Je vous met le code complet :

Sub Excel_vers_Word()
Dim WordApp As Object, WordDoc As Object
Dim NDF As String, NDF2 As String, Rep As String
Dim vaData As Variant

    NDF = ActiveWorkbook.Path & "\TrameRetraite.docx"  ' le doc modèle est placé dans le même dossier que le xlsm
    Rep = ActiveWorkbook.Path & "\DocComplets\"     ' pour enregistrer le doc résultat dans un sous-dossier

    If Not Exist_Fichier(NDF) Then                  ' vérifie l'existence du doc modèle
        MsgBox "Document 'modeleword.docx' manquant", vbExclamation, "COLINE"
    Else
        If Not Exist_Rep(Rep) Then MkDir Rep        ' vérifie l'existence du sous-dossier et le crée éventuellement
        NDF2 = Rep & "Doc_créé_" & Format(Now(), "yyyymmdd_hhmm") & ".docx"  ' pour enregistrer le résultat

        On Error Resume Next
        If Fichier_IsOpen(NDF) Then                 ' vérifie si le modèle est déjà ouvert
           Set WordApp = GetObject(, "Word.Application")
           Set WordDoc = WordApp.Documents(NDF)
        Else                                        ' sinon ouvre l'appli word et le modèle
            Set WordApp = CreateObject("Word.Application")
            Set WordDoc = WordApp.Documents.Open(NDF, ReadOnly:=False)
        End If

'Sheets("Tableau").Range("A1:A10").Select
'Selection.Copy

        With WordApp
            .Visible = False

            'WordDoc.Bookmarks("Surcote").Range.Paste
            WordDoc.Bookmarks("Date").Range.Text = Worksheets("Client").Cells(4, 2)
            WordDoc.Bookmarks("AgeDépart").Range.Text = Worksheets("Client").Cells(15, 2)
            WordDoc.Bookmarks("AgeDépart2").Range.Text = Worksheets("Client").Cells(15, 2)
            WordDoc.Bookmarks("AnneeNaissanceClient").Range.Text = Worksheets("Client").Cells(12, 2)
            WordDoc.Bookmarks("CivilitéClient").Range.Text = Worksheets("Client").Cells(1, 2)
            WordDoc.Bookmarks("DateDépart").Range.Text = Worksheets("Client").Cells(14, 2)
            WordDoc.Bookmarks("DateDépart2").Range.Text = Worksheets("Client").Cells(14, 2)
            WordDoc.Bookmarks("DateDépart3").Range.Text = Worksheets("Client").Cells(14, 2)
            WordDoc.Bookmarks("DateDépart4").Range.Text = Worksheets("Client").Cells(14, 2)
            WordDoc.Bookmarks("MailIntervenant").Range.Text = Worksheets("Client").Cells(29, 2)
            WordDoc.Bookmarks("TelephoneIntervenant").Range.Text = Worksheets("Client").Cells(30, 2)
            WordDoc.Bookmarks("PrénomNomIntervenant").Range.Text = Worksheets("Client").Cells(28, 2)
            WordDoc.Bookmarks("TrimestresRequis").Range.Text = Worksheets("Client").Cells(13, 2)
            WordDoc.Bookmarks("TrimestresRequis2").Range.Text = Worksheets("Client").Cells(13, 2)
            WordDoc.Bookmarks("MontantDépartAn").Range.Text = Worksheets("Client").Cells(11, 9)
            WordDoc.Bookmarks("MontantDépartMois").Range.Text = Worksheets("Client").Cells(12, 9)
            WordDoc.Bookmarks("MalusAgirc").Range.Text = Worksheets("Client").Cells(13, 9)
            WordDoc.Bookmarks("DateDépartPlus1").Range.Text = Worksheets("Client").Cells(21, 2)
            WordDoc.Bookmarks("PrenomNomClient").Range.Text = Worksheets("Client").Cells(11, 2)
            WordDoc.Bookmarks("PrenomNomClient2").Range.Text = Worksheets("Client").Cells(11, 2)

            If Worksheets("Client").Cells(17, 2) = "Non" Then
            WordDoc.Bookmarks("CarrièreLongue").Range.Delete
            End If

            If Worksheets("Client").Cells(11, 6) = "Non" Then
            WordDoc.Bookmarks("ComplémentaireSalarié").Range.Delete
            End If

            If Worksheets("Client").Cells(12, 6) = "Non" Then
            WordDoc.Bookmarks("ComplémentaireIndépendant").Range.Delete
            End If

            If Worksheets("Client").Cells(11, 6) = "Non" And Worksheets("Client").Cells(12, 6) = "Non" Then
            WordDoc.Bookmarks("CotisationTrimestresSalarié").Range.Delete
            WordDoc.Bookmarks("RetraiteBaseSalarié").Range.Delete
            End If

            If Worksheets("Client").Cells(13, 6) = "Non" Then
            WordDoc.Bookmarks("PointsGratuitsMSA").Range.Delete
            WordDoc.Bookmarks("RetraiteMSA").Range.Delete
            WordDoc.Bookmarks("CotisationTrimestresMSA").Range.Delete
            WordDoc.Bookmarks("CERLibéraliséMSA").Range.Delete
            End If

            ' etc ...

            ' s'il y a un tableau dans le doc word
            With WordDoc.Tables(1)
                ' ajoute le contenu de C2 dans la cellule ligne 2 colonne 2 du tableau word
                Sheets("Client").cell(2, 2).Range.InsertAfter ActiveSheet.Range("C2").Value
                ' ajoute le contenu de D2 dans la cellule ligne 2 colonne 3 du tableau word
                Sheets("Client").cell(2, 3).Range.InsertAfter ActiveSheet.Range("D2").Value
                ' ...
            End With

        End With

        WordDoc.Application.ActiveDocument.SaveAs NDF2  ' enregistre le doc complété

        WordApp.Visible = True ' ou bien : WordApp.Application.Quit ' pour fermer après remplissage
        Set WordDoc = Nothing
        Set WordApp = Nothing
        MsgBox "Document word prêt"

    End If

End Sub
Le 17/05/2021 à 16:48

up

Le 17/05/2021 à 16:55

Bonjour,

Voici une démo de création d'un tableau xl à l'emplacement d'un signet d'un doc

Sub Copie_tblo_signet(Signet As String, Plage As Range)
Dim lg As Integer, cl As Integer, i As Integer, j As Integer

    Set Rng = WordDoc.Bookmarks(Signet).Range
    lg = Plage.Rows.Count
    cl = Plage.Columns.Count
    With WordDoc.Tables.Add(Range:=Rng, NumRows:=lg, NumColumns:=cl)
        For i = 1 To lg
            For j = 1 To cl
                With .cell(i, j)
                    .Range.Text = Plage(i, j).Value
                    .Borders.Enable = True
                End With
            Next j
        Next i
    End With
End Sub

2 méthodes différentes dans le zip

Pierre

22demo-modif-tableau-2.zip (71.50 Ko)
Le 17/05/2021 à 17:03

Merci Pierre,

Je comprend où mettre mon signet, mais je ne vois pas où est ce que je dois définir mon tableau source.

Le 17/05/2021 à 17:16

Dans la démo proposée, l'appel de la procédure se fait comme ceci =>

Copie_tblo_signet "Pour_Tableau", Sheets("Feuil1").Range("D1:H6")

ici pour copier le contenu de la zone D1:H6 de l'onglet Feuil1 à l'emplacement du signet nommé "Pour_Tableau" dans le doc

Pierre

Ps : ce n'est qu'une démo simplette ...

Le 17/05/2021 à 17:36

Donc je dois l'ajouter dans mon code ?

Autre problème, j'ai une erruer "Variable objet ou variable de bloc With non définie" quand j'implémente le gros morceau. J'ai remarqué que c'était le "set rng ...", la macro fonctionne (sauf le tableau évidement) quand je ne le met pas.

J'avoue que j'ai du mal à visualiser comment intégrer ton morceau au mien.

Le 17/05/2021 à 18:49

Mouais ...

Dans ma démo les variables WordApp, WordDoc et Rng sont déclarées comme public ...

Public WordApp As Object, WordDoc As Object, Rng As Object
Rechercher des sujets similaires à "remplacer signet word tableau"