XL 2019 Copier coller de Excel vers word

ben haj salah · 13 Avril 2021

Bonjour tout le monde

Voilà, j'ai un fichier excel contenantdes tableau, et je dois réaliser un script en vba permettant de créer un document word et d'y insérer le tableau après le titre que je définis.

Quelqu'un aurait t'il une petite aide sur mon problème du collage des données après un titre.

Merci

job75 · 13 Avril 2021

Bonjour ben haj salah, bienvenue sur XLD,

Téléchargez les fichiers joints dans le même dossier (le bureau).

Puis lancez cette macro en cliquant sur le bouton :

VB:

Sub Copier_vers_Word()
Dim Wapp As Object, Wdoc As Object
On Error Resume Next
Set Wapp = GetObject(, "Word.Application")
If Wapp Is Nothing Then Set Wapp = CreateObject("Word.Application")
Wapp.Visible = True
Set Wdoc = Wapp.documents.Open(ThisWorkbook.Path & "\CE.docx") 'chemin et nom à adapter
If Wdoc Is Nothing Then MsgBox "Document Word introuvable !", 48: Exit Sub
Wapp.Selection.WholeStory
Wapp.Selection.Delete 'RAZ
Range("A1", [Tableau1]).Copy 'Copier
Wapp.Selection.Paste 'Coller
Application.CutCopyMode = 0
AppActivate "Word" 'activation facultative
End Sub

Pour voir le code allez dans VBA par Alt+F11.

A+

job75 · 13 Avril 2021

Fichier (2) avec Mise en page (centrage) des paragraphes :

VB:

Sub Copier_vers_Word()
Dim Wapp As Object, Wdoc As Object
On Error Resume Next
Set Wapp = GetObject(, "Word.Application")
If Wapp Is Nothing Then Set Wapp = CreateObject("Word.Application")
Wapp.Visible = True
Set Wdoc = Wapp.documents.Open(ThisWorkbook.Path & "\CE.docx") 'chemin et nom à adapter
If Wdoc Is Nothing Then MsgBox "Document Word introuvable !", 48: Exit Sub
Wapp.Selection.WholeStory
Range("A1", [Tableau1]).Copy 'Copier
Wapp.Selection.Paste 'Coller
Application.CutCopyMode = 0
'---Mise en page---
Wapp.Selection.WholeStory
With Wapp.Selection.ParagraphFormat
    .SpaceBefore = 3
    .SpaceAfter = 3
End With
Wapp.Selection.EndKey 6 'wdStory
AppActivate "Word" 'activation facultative
End Sub

XL 2019 Copier coller de Excel vers word

ben haj salah

XLDnaute Nouveau

Pièces jointes

job75

XLDnaute Barbatruc

Pièces jointes

job75

XLDnaute Barbatruc

Pièces jointes

Discussions similaires