Excel从报表到Word报表1,2,3

Excel从报表到Word报表

1. 准备好word文档，把bookmark设好，用以对应Table和chart的名字。
2. Excel文档建好，同样，worksheets的命名和table命名相同。
3. Chart生成，这个可以自动生成，当然也可以手动选择。这里就不在包含这个部分。

Marco分为3个部分：
A: 把Table数组导入到已经建立好的word文档
B: 把Chart尺寸标准化
C: 把chart导入word并按照对应的bookmark来插入。
A:

Option Base 1 'Force arrays to start at 1 instead of 0
Sub ExcelTablesToWord()
 ' (VBE > Tools > References > Microsoft Word 16.0 Object Library)
Dim tbl As Excel.Range
Dim wordApp As Word.Application
Dim myDoc As Word.Document
Dim WordTable As Word.Table
Dim TableArray As Variant
Dim BookmarkArray As Variant

'List of Table Names (To Copy)
  TableArray = Array("Table1", "Table2", "Table3", "Table4", "Table5", "Table6", "Table7", "Table8", "Table9", "Table10", "Table11", "Table12", "Table13", "Table14", "Table15")
  
'List of Word Document Bookmarks (To Paste To)
  BookmarkArray = Array("Bookmark1", "Bookmark2", "Bookmark3", "Bookmark4", "Bookmark5", "Bookmark6", "Bookmark7", "Bookmark8", "Bookmark9", "Bookmark10", "Bookmark11", "Bookmark12", "Bookmark13", "Bookmark14", "Bookmark15")
    
'  ChartArray = Array("Chart1", "Chart2", "Chart3", "Chart4", "Chart5", "Chart6", "Chart7", "Chart8", "Chart9", "Chart10", "Chart11", "Chart12", "Chart13", "Chart14", "Chart15")
'  CbookmarkArray = Array("Cht1", "Cht2", "Cht3", "Cht4", "Cht5", "Cht6", "Cht7", "Cht8", "Cht9", "Cht10", "Cht11", "Cht12", "Cht13", "Cht14", "Cht15")

'Optimize Code
  Application.ScreenUpdating = False
  Application.EnableEvents = False

'Set Variable Equal To Destination Word Document
  On Error GoTo WordDocNotFound
    Set wordApp = GetObject(class:="Word.Application")
    wordApp.Visible = True
    Set myDoc = wordApp.Documents("Doc1.docx")
  On Error GoTo 0
    
'Loop Through and Copy/Paste Multiple Excel Tables
  For x = LBound(TableArray) To UBound(TableArray)

    'Copy Table Range from Excel
      Set tbl = ThisWorkbook.Worksheets(x).ListObjects(TableArray(x)).Range
      tbl.Copy
    
    'Paste Table into MS Word (using inserted Bookmarks -> ctrl+shift+F5)
      myDoc.Bookmarks(BookmarkArray(x)).Range.PasteExcelTable _
        Linkedtoexcel:=False, _
        wordformatting:=False, _
        RTF:=False
    
    'Autofit Table so it fits inside Word Document
      Set WordTable = myDoc.Tables(x)
      WordTable.AutoFitBehavior (wdAutoFitWindow)

  Next x

    
'Completion Message
  MsgBox "Copy/Pasting Complete!", vbInformation
  GoTo EndRoutine
  
'ERROR HANDLER
WordDocNotFound:
  MsgBox "Microsoft Word file 'Excel Table Word Report.docx' is not currently open, aborting.", 16

'Put Stuff Back The Way It Was Found
EndRoutine:
'Optimize Code
  Application.ScreenUpdating = True
  Application.EnableEvents = True

'Clear The Clipboard
  Application.CutCopyMode = False

Call chartSize
Call Chart

End Sub

B:

Sub chartSize()

Dim xlShp As Excel.Shape

For Each wsh In ThisWorkbook.Worksheets
    For Each xlShp In wsh.Shapes
        
        With xlShp
        .Width = 500
        .Height = 240
        End With
    
    Next xlShp
    
Next wsh

End Sub

C:

Sub Chart()
Dim wdApp As New Word.Application
Dim wdDoc As Word.Document
Dim xlShp As Excel.Shape
    Set wdApp = GetObject(class:="Word.Application")
    wdApp.Visible = True
    Set wdDoc = wdApp.Documents("Doc1.docx")
wdApp.Visible = True
For Each wsh In ThisWorkbook.Worksheets
    With wdDoc
    For Each xlShp In wsh.Shapes
      If .Bookmarks.Exists(xlShp.Name) Then
      xlShp.Copy
      .Bookmarks(xlShp.Name).Range.Paste
      End If
     Next xlShp
    End With    
Next wsh
Set wdDoc = Nothing: Set wdApp = Nothing
End Sub

改天把Table的导入和chart的统一 一下。
另外，还需要把对应的评论导入到对应位置，以及把form control 下拉框自动选择并做以上操作后，word文档另存为对应名称的文档。