Microsoft 365 copier coller plusieurs tableaux excel dans un même word

[M-1]

Bonjour,

J'ai réussi à faire un code pour copier coller un tableau dans word. Cependant, j'aimerais copier coller un autre tableau, Table_3 et d'autres encore dans ce même word à différents endroits, identifiés par signet. Avez-vous une idée ? Voici le code qui fonctionne actuellement pour un seul tableau:

Sub Export_Table_Word_2()



'Word Objects



Dim WdApp As Object

Dim WdDoc As Object

Dim wbmRange As Object



'Excel Objects



Dim wbBook As Workbook

Dim wsSheet As Worksheet

Dim Table_2 As Range



'Initialize the excel objects

Set wbBook = ThisWorkbook

Set wsSheet = wbBook.Worksheets("Sheet")

Set Table_2 = wsSheet.Range("B6:I34")





'Initialize the word objects

Set WdApp = CreateObject("Word.application")

WdApp.Visible = True

Set WdDoc = WdApp.Documents.Open(" XXXX")

Set wbmRange = WdDoc.Bookmarks("Table_2")



wbmRange.Select

Table_2. CopyPicture xlScreen, xlPicture

WdApp.Selection.Paste

Application.CutCopyMode = 0



End Sub


Merci,

 

[Staple1600]

Bonjour M-1, le fil

Tout vient à point à qui sait attendre
(Et comme j'étais réveillé et mon PC aussi, alors j'ai ouvert Excel )
NB: Pensez à changer le chemin et le nom du fichier avant de tester

Const fic_WORD As String = "C:\Users\STAPLE1600\Documents\ESSAIS_WORD\test.docx"
Option Base 1
Sub Copier_TableauxExcel_vers_Tables__WORD()
'Déclarations variables
Dim xlAry, tSignets, LO_rng As Excel.Range, i%, WordApp As Word.Application, wd_Doc As Word.Document, WordTable As Word.Table
xlAry = Array("Tableau1", "Tableau2", "Tableau3"):  tSignets = Array("Signet_01", "Signet_02", "Signet_03")

'Figer rafraichissement écran & évenements
Application.ScreenUpdating = 0: Application.EnableEvents = 0

'création Objet Word
Set WordApp = CreateObject("Word.Application"): WordApp.Visible = True
'Ouvrir le document Word
Set wd_Doc = WordApp.Documents.Open(fic_WORD)
'Boucler sur le tableau des signets
    For i = LBound(xlAry) To UBound(xlAry)
    'copier les tableaux Excel (ListObject) un à un
        Set LO_rng = Worksheets(1).ListObjects(xlAry(i)).Range: LO_rng.Copy
        'les coller dans le document Word en tant que Table Word à l'emplacement des signets
        'préalablement définis dans le document Word.
        wd_Doc.Bookmarks(tSignets(i)).Range.PasteExcelTable False, False, False
        'ajustement des Tables
        Set WordTable = wd_Doc.Tables(i): WordTable.AutoFitBehavior (wdAutoFitWindow)
    Next i
MsgBox "Traitement terminé", vbInformation, "Recopie Tableaux Excel vers Tables WORD"

'Rétablir rafraichissement écran & évenements et vider clipboard
Application.ScreenUpdating = -1: Application.EnableEvents = -1
Application.CutCopyMode = False
End Sub

Test OK sur mon PC

Situation de test
Le classeur et le document Word sont dans le même répertoire
Le document Word contient 3 signets nommés Signet_01, Signet_02 et Signet_03
Dans le classeur, une seule feuille avec trois tableaux structurés
(ce que le VBA d'Excel nomme ListObject)

voir résultat ci-dessous