VBA Excel：获取多个选项卡并输出为单个 Word 文档

Question

我有多个 Excel 选项卡，我想将它们输出到 Word 文档中。我能够获取一些代码（当然是在社区的帮助下！）并将我的 excel 的第一个选项卡输出到 word 文档。当我尝试获取第 3 页上的第二个选项卡时，它只是替换了我创建的第一页。

我还尝试了另一种方法，将每张工作表导出为单独的 word 文档，然后将它们合并，但这也遇到了同样的问题，单词只是一遍又一遍地替换了第一页。

基本上我的代码执行以下操作：

1. 创建具有特定边距轮廓的 Word 文件。
2. 将表格设置为 Excel 工作表中的已用范围。复制这个
3. 粘贴到单词中。

再试下一张。遇到问题。

(设置 tbl = ThisWorkbook.Worksheets(Sheet3.Name).UsedRange)

Dim tbl As Excel.Range
Dim WordApp As Word.Application

Dim WordTable As Word.Table

Dim MainDoc As Word.Document
Dim mydoct1 As Word.Document

Dim sFolderPath As String

Sub Export_to_Word()

    Application.ScreenUpdating = False
    Application.EnableEvents = False
    'Create an Instance of MS Word
    On Error Resume Next
        'Is MS Word already opened?
        Set WordApp = GetObject(class:="Word.Application")
        'Clear the error between errors
        Err.Clear
        'If MS Word is not already open then open MS Word
        If WordApp Is Nothing Then Set WordApp = CreateObject(class:="Word.Application")
        'Handle if the Word Application is not found
        If Err.Number = 429 Then
            MsgBox "Microsoft Word could not be found, aborting."
            GoTo EndRoutine
        End If
    On Error GoTo 0
      
    'Make MS Word Visible and Active
    WordApp.Visible = True
    WordApp.Activate
        
    'Create a New Document
    Set mydoc1 = WordApp.Documents.Add
    With mydoc1.PageSetup
        .TopMargin = Application.CentimetersToPoints(1)
        .BottomMargin = Application.CentimetersToPoints(1)
        .LeftMargin = Application.CentimetersToPoints(1)
        .RightMargin = Application.CentimetersToPoints(1)
    End With
    
    Set tbl = ThisWorkbook.Worksheets(Sheet2.Name).UsedRange
    tbl.Copy
        
    'Paste Table into MS Word
    mydoc1.Paragraphs(1).Range.PasteExcelTable False, False, False
    
    'Autofit Table so it fits inside Word Document
    Set WordTable = mydoc1.Tables(1)
    WordTable.AutoFitBehavior (wdAutoFitWindow)
    
    
    mydoc1.Range.InsertAfter Chr(13) & "Hello"
    
    my.Collapse Direction:=wdCollapseEnd
    mydoc1.Range.InsertBreak
    
    Set tbl = ThisWorkbook.Worksheets(Sheet3.Name).UsedRange
    tbl.Copy
    
    mydoc1.Range.PasteExcelTable False, False, False
    
EndRoutine:
    
    'Clear The Clipboard
    Application.CutCopyMode = False
    
    mydoc1.SaveAs Filename:=Application.ActiveWorkbook.Path & "\Application_Temp\" & "Sheet1"
    mydoc1.Close
    
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    
End Sub

Answer 1

在 Word 中向现有内容添加内容的技巧是使用 Range 对象。考虑像不可见的 selections 这样的范围，其主要区别在于只能有一个选择，但代码可以根据需要使用尽可能多的范围来操作内容。

对于您的评论：Word 中的 Selection 非常类似于 Excel 中的 ActiveCell； Excel 编码专家总是会说：避免使用“Active”——任何东西，使用特定对象，例如 Ranges 而不是 ActiveCell。 Word 也是如此 :-) 您永远无法确定哪个是活动单元格，或者选择在哪里； Range("A3") 告诉你确切的意思，Document.Paragraphs(2) 一样。

本着这种精神，我更改了问题中的代码摘录，在文档的整个主体中声明 (Dim) 和实例化 (Set) Range 对象。然后该范围“折叠”（将其视为按选择的右箭头）到其端点，这样添加新内容就不会替换以前的内容（与在选择上键入相同的问题）。

Dim rngTarget as Object     'Word.Range for early-binding or within Word
Set rngTarget = mydoc1.Paragraphs(1).Range

'Paste Table into MS Word
rngTarget.PasteExcelTable False, False, False

'Autofit Table so it fits inside Word Document
Set WordTable = mydoc1.Tables(1)
WordTable.AutoFitBehavior (wdAutoFitWindow)

rngTarget.InsertAfter Chr(13) & "Hello"    
rngTarget.Collapse Direction:=wdCollapseEnd

rngTarget.InsertBreak 7  'Word.WdBreakType.wdPageBreak (default type)
rngTarget.Collapse Direction:=wdCollapseEnd

Set tbl = ThisWorkbook.Worksheets(Sheet3.Name).UsedRange
tbl.Copy

rngTarget.PasteExcelTable False, False, False

我还对清理进行了一些调整。使用外部应用程序时，正确释放其声明和实例化的对象非常重要。这应该按照它们创建的相反顺序来完成。如果这些没有正确释放，它可能会将它们保存在内存中，从而在下次运行代码时导致错误。

EndRoutine:

  'Clear The Clipboard
  Application.CutCopyMode = False

  mydoc1.SaveAs Filename:=Application.ActiveWorkbook.Path & "\Application_Temp\" & "Sheet1"
  mydoc1.Close
  Set rngTarget = Nothing
  Set WordTable = NOthing
  Set tbl = Nothing
  Set mdyDoc1 = Nothing

  'Possibly you also want
  'WordApp.Quit
  'This you definitely need
  Set WordApp = Nothing

  Application.ScreenUpdating = True
  Application.EnableEvents = True