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 .
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