Copier un tableau de taille variable vers un signet word

Bonjour,

J'ai un tableau "A1:Di" i étant variable dans ma feuille F1. Mon objectif est de copier celui-ci et de le coller à l'emplacement d'un signet S1 d'un document word que j'ouvre.

Pour info j'arrive à demander l'utilisateur de renseigner le document à ouvrir mais je ne sais pas comment faire ma boucle pour trouver la dernière Valeur Di afin de réaliser la copie la copie A1:Di et le coller dans mon document word.

Merci pour votre aide

Bonjour,

Sur la feuille active :

Sub Test()

    Dim Plage As Range

    With ActiveSheet: Set Plage = .Range(.Cells(1, 1), .Cells(.Rows.Count, 4).End(xlUp)): End With

    MsgBox Plage.Address(0, 0)

End Sub

Bonjour,

Merci Theze.

J'ai insérer ta ligne de code dans mon programme pour copier le tableau et le coller dans mon documebt word à ouvrir.

Mon idée ci-dessous, sauf que j'ai une erreur d'excution 438 sur la ligne :

Set Plage1 = .Range(.Cells(1, 1), .Cells(.Rows.Count, 4).End(xlUp))

            
            Sub  test ()

            Dim Plage1 As Range
            mondoc = InputBox("Saisir le nom de la fiche", "FICHE")
            Set WordApp = CreateObject("word.Application")
            Path = "D:\MacroV3.2\"
            NameFile = mondoc & ".docx"
            Group = Path & NameFile
            With WordApp
            .Visible = True
            Set WordDoc = .Documents.Open("" & Group & "")

            With WordDoc
            'On Error GoTo sortie
                'Copie Tableau 1 depuis Excel\Feuil1
                Sheets("Feuil1").Select
                Set Plage1 = .Range(.Cells(1, 1), .Cells(.Rows.Count, 4).End(xlUp))
                Plage.Select
                'Cherche signet1 dans le document ouvert
                .Plage.Goto What:=wdGoToBookmark, Name:="S1"

                'Colle Tableau 1 à l'emplacement signet S1
                .Selection.PasteSpecial Link:=True, DataType:=wdPasteOLEObject, Placement:=wdInLine, DisplayAsIcon:=False
            End With
            End With

Bonjour,

Désolé,

Mon erreur se trouve plutôt à la ligne : .Selection.Plage.Goto What:=wdGoToBookmark, Name:="S1"

Sub test ()
Dim Plage As Range 

    mondoc = InputBox("Saisir le nom de la fiche Test", "FONCTIONS")
    NDF = ActiveWorkbook.Path & "\" & "Fiche_Test" & Format(Now(), "_hhmm")
    Set WordApp = CreateObject("word.Application")
    Path = "D:\MacroV3.2\"
    NameFile = mondoc & ".docx"
    Group = Path & NameFile
    With WordApp
    .Visible = True
    Set WordDoc = .Documents.Open("" & Group & "")

        With WordDoc
            'On Error GoTo sortie
                'Copie Tableau 1 depuis Excel\Feuil1

                With ActiveSheet
                Set Plage = .Range(.Cells(1, 1), .Cells(.Rows.Count, 4).End(xlUp))
                'Cherche signet1 dans le document ouvert
                .Selection.Plage.Goto What:=wdGoToBookmark, Name:="S1"

                'Colle Tableau 1 à l'emplacement signet S1
                .Selection.PasteSpecial Link:=True, DataType:=wdPasteOLEObject, Placement:=wdInLine, DisplayAsIcon:=False
                End With
        End With
    End With
   End Sub 

Bonjour,

Il y a plusieurs erreurs, la première, tu fais :

With WordDoc
    Sheets("Feuil1").Select
    Set Plage1 = .Range(.Cells(1, 1), .Cells(.Rows.Count, 4).End(xlUp))

le point devant Range le parente au document Word alors qu'il est l'enfant de la feuille de calcul !

Ensuite, tu utilises un objet Range Plage.Select en dessous qui n'est pas déclaré, je suppose que c'est Plage1.Select que tu veux utiliser

Puis, "Plage" n'est ni une propriété ni une méthode de l'objet Selection, c'est soit Plage soit Selection et Goto de même, n'est pas une propriété ou méthode de ces objets :

.Selection.Plage.Goto What:=wdGoToBookmark, Name:="S1"

Ton code est entièrement à revoir car en l'état il ne peut vraiment pas fonctionner.

Je regarde et reviens plus tard

Re,

Voici un code qui devrait fonctionner :

Sub Test()

    Dim AppWord As Object
    Dim Doc As Object
    Dim Tbl As Object
    Dim Plage As Range
    Dim Cel As Range
    Dim Fiche As String
    Dim Chemin As String
    Dim I As Integer

    Fiche = InputBox("Saisir le nom de la fiche", "FICHE")
    If Fiche = "" Then Exit Sub

    Chemin = "D:\MacroV3.2\"

    With Worksheets("Feuil1"): Set Plage = .Range(.Cells(1, 1), .Cells(Rows.Count, 4).End(xlUp)): End With

    Set AppWord = CreateObject("Word.Application")

    With AppWord

        .Visible = True

        Set Doc = .Documents.Open(Chemin & Fiche & ".docx")

        With Doc

            'crée un tableau vide au niveau du signet avec le nombre de lignes et colonne de la plage
            Set Tbl = .Tables.Add(.Bookmarks("S1").Range, Plage.Rows.Count, Plage.Columns.Count, 1, 1)

            'remplie le tableau
            With Tbl

                For Each Cel In Plage.Columns(1).Cells

                        I = I + 1
                        .Cell(I, 1).Range.Text = Cel.Text
                        .Cell(I, 2).Range.Text = Cel.Offset(0, 1).Text
                        .Cell(I, 3).Range.Text = Cel.Offset(0, 2).Text
                        .Cell(I, 4).Range.Text = Cel.Offset(0, 3).Text

                Next Cel

                'mise en gras de la première ligne du tableau que je suppose être les entêtes de colonnes
                .Rows(1).Range.Bold = True

            End With

        End With

    End With

End Sub

Bonjour,

Theze,

Merci beaucoup, ton code fonctionne à merveille.

Encore une fois merci.

Bonjour,

Je reviens sur ce sujet car je veux faire évoluer mon code Sub Test (). Celui-ci me créée un tableau au niveau du signet S2 de mon document word.

Sauf que le tableau ne prend pas en compte les remplissages des cellules que j'ai effectuées à partir de ma première boucle J

Pourriez-vous m'aider à résoudre ce problème.

Vous remerciant par avance

Sub Test()
Dim  Ligne As String
Dim I As Integer, J As Integer
Dim AppWord As Word.Document, WordDoc As Object, Tbl As Object, Tabl As Object
Dim plages As Range, cels As Range

  With ActiveSheet: 'Set plages = .Range(.Cells(2, 2), .Cells(Rows.Count, 4).End(xlUp))

                   'Remplissage des cellules

                    For J = .Range("B" & .Rows.Count).End(xlUp).Row To 2 Step -1

                             If Cells(J, 2).Value <> "" Then

                                 Ligne = Cells(J, 2).Row

                             End If
                                 .Range("B" & Ligne).Interior.ColorIndex = 15
                                 .Range("C" & Ligne).Interior.ColorIndex = 15
                                 .Range("D" & Ligne).Interior.ColorIndex = 15
                                 .Range("E" & Ligne).Interior.ColorIndex = 15
                     Next J

End With

        With Worksheets("Feuil2"): Set plages = .Range(.Cells(1, 2), .Cells(Rows.Count, 5).End(xlUp)): End With

    Set AppWord = Word.Documents("Fiche.docx")

    With AppWord

            'crée un tableau vide au niveau du signet avec le nombre de lignes et colonne de la plages
          Set Tbl = .Tables.Add(.Bookmarks("S2").Range, plages.Rows.Count, plages.Columns.Count, 1, 1)

            'remplie le tableau
             With Tbl

                For Each cels In plages.Columns(1).Cells

                        I = I + 1
                        .Cell(I, 1).Range.Text = cels.Text
                        .Cell(I, 2).Range.Text = cels.Offset(0, 1).Text
                        .Cell(I, 3).Range.Text = cels.Offset(0, 2).Text
                        .Cell(I, 4).Range.Text = cels.Offset(0, 3).Text

                Next cels

                End With
     End With
End Sub

Bonjour,

Je ne comprend pas trop ce que tu veux faire mais en l'état, ton code ne peut pas fonctionner !

J'ai repris mon code précédant et j'ai ajouté une coloration des cellules du tableau dans Word de façon à ce qu'elles aient les mêmes couleur que les cellules dans Excel :

Sub Test()

    Dim AppWord As Object
    Dim Doc As Object
    Dim Tbl As Object
    Dim Plage As Range
    Dim Cel As Range
    Dim Fiche As String
    Dim Chemin As String
    Dim I As Integer

    Fiche = InputBox("Saisir le nom de la fiche", "FICHE")
    If Fiche = "" Then Exit Sub

    Chemin = "D:\MacroV3.2\"

    With Worksheets("Feuil1"): Set Plage = .Range(.Cells(1, 1), .Cells(Rows.Count, 4).End(xlUp)): End With

    Set AppWord = CreateObject("Word.Application")

    With AppWord

        .Visible = True

        Set Doc = .Documents.Open(Chemin & Fiche & ".docx")

        With Doc

            'crée un tableau vide au niveau du signet avec le nombre de lignes et colonne de la plage
            Set Tbl = .Tables.Add(.Bookmarks("S2").Range, Plage.Rows.Count, Plage.Columns.Count, 1, 1)

            'remplie le tableau
            With Tbl

                For Each Cel In Plage.Columns(1).Cells

                    I = I + 1
                    .Cell(I, 1).Range.Text = Cel.Text
                    .Cell(I, 2).Range.Text = Cel.Offset(0, 1).Text
                    .Cell(I, 3).Range.Text = Cel.Offset(0, 2).Text
                    .Cell(I, 4).Range.Text = Cel.Offset(0, 3).Text

                    'colore les cellules dans Word de la même couleur que celles dans Excel
                    .Cell(I, 1).Shading.BackgroundPatternColor = Cel.Interior.Color
                    .Cell(I, 2).Shading.BackgroundPatternColor = Cel.Interior.Color
                    .Cell(I, 3).Shading.BackgroundPatternColor = Cel.Interior.Color
                    .Cell(I, 4).Shading.BackgroundPatternColor = Cel.Interior.Color

                Next Cel

                'mise en gras de la première ligne du tableau que je suppose être les entêtes de colonnes
                .Rows(1).Range.Bold = True

            End With

        End With

    End With

End Sub

Re,

Merci theze,

J'ai testé ton code mais ce n'est pas exactement ce que j'aimerais faire.

Je te joins un fichier pour que tu puisses voir.

Je veux exporter A1:D10 sous forme d'un tableau vers un signet de mon document word en prenant bien soins la mise en forme de la Feuil1 du classeur Tableau.xlsm .

37tableau.xlsm (17.64 Ko)

En te remerciant

Mais le code que je t'ai donné crée un tableau §

Sinon, copier le tableau Excel et le coller dans Word :

Sub Test()

    Dim AppWord As Object
    Dim Doc As Object
    Dim Plage As Range
    Dim Cel As Range
    Dim Fiche As String
    Dim Chemin As String
    Dim I As Integer

    Fiche = InputBox("Saisir le nom de la fiche", "FICHE")
    If Fiche = "" Then Exit Sub

    Chemin = "D:\MacroV3.2\"

    With Worksheets("Feuil1"): Set Plage = .Range(.Cells(1, 1), .Cells(Rows.Count, 4).End(xlUp)): End With

    Set AppWord = CreateObject("Word.Application")

    With AppWord

        .Visible = True

        Set Doc = .Documents.Open(Chemin & Fiche & ".docx")

        With Doc

            Plage.Copy
            .Bookmarks("S2").Range.PasteExcelTable False, False, False

        End With

        Application.CutCopyMode = False

    End With

End Sub

Bonjour,

J'avais pas du tout penser à ça. Merci et ça marche bien

Rechercher des sujets similaires à "copier tableau taille variable signet word"