1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74
| ub Export_Table_Word(ByVal TableName As String, ByVal shtName As String, ByVal tableWord As String, ByVal i As Integer)
'Name of the existing Word doc.
'Const
stWordReport = Sheets("Macros").Range("M6").Value
'Word objects.
Dim wdApp As Word.Application
Dim wdDoc As Word.Document
Dim wdbmRange As Word.Range
'Excel objects.
Dim wbBook As Workbook
Dim wsSheet As Worksheet
Dim rnReport As Range
'Initialize the Excel objects.
Set wbBook = ThisWorkbook
Set wsSheet = wbBook.Worksheets(shtName)
Set rnReport = wsSheet.Range(TableName)
'Initialize the Word objects.
Set wdApp = New Word.Application
Set wdDoc = wdApp.Documents.Open(wbBook.Path & "\" & stWordReport & ".docm")
wdApp.Visible = True
Set wdbmRange = wdDoc.Bookmarks(tableWord).Range
'If the macro has been run before, clean up any artifacts before trying to paste the table in again.
'On Error Resume Next
'With wdDoc.InlineShapes(1)
' .Select
'.Delete
'End With
'On Error GoTo 0
'Turn off screen updating.
Application.ScreenUpdating = False
'Copy the report to the clipboard.
rnReport.Copy
'Select the range defined by the "Report" bookmark and paste in the report from clipboard.
With wdbmRange
.Select
.PasteSpecial link:=False, _
DataType:=wdPasteEnhancedMetafile, _
Placement:=wdInLine, _
DisplayAsIcon:=False
End With
'permet d'insérer un saut de page après le tableau
Set myRange = wdbmRange
With myRange
.Collapse Direction:=wdCollapseEnd
.InsertBreak Type:=wdPageBreak
End With
'Save and close the Word doc.
With wdDoc
.Save
.Close
End With
With wdApp
.Quit
End With
'Call NettoyerPressPapiers
End Sub |
Partager