Excel VBA：将工作簿另存为Word文档

Question

我想将工作簿（所有工作表）保存为一个Word文档。 一张纸是文档中的一页。

我只找到用于保存activeSheet的代码。

Sub ExcelToWord()
Dim ws As Worksheet
Set ws = ActiveSheet
Dim objWd As Object
Set objWd = CreateObject("word.application")
objWd.Visible = True
Dim objDoc As Object
Set objDoc = objWd.Documents.Add
objDoc.PageSetup.Orientation = 1 '  portrait = 0
Application.ScreenUpdating = False
ws.UsedRange.Copy
objDoc.Content.Paste
Application.CutCopyMode = False
Application.DisplayAlerts = False
objDoc.SaveAs (Application.ThisWorkbook.Path & "\dokument.docx")
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

感谢您的回复。

Answer 1

几项快速的操作即可为您提供解决方案。

第一个是循环浏览工作簿中的工作表，如下所示：

Dim ws As Worksheet
For Each ws in ThisWorkbook.Sheets
    Debug.Print "The used range is " & ws.UsedRange.Address
Next ws

下一部分是了解如何完成向Word文档添加内容的过程。 主要概念涉及文档插入点的位置-通常这是当前的Selection 。

当您剪切并粘贴到Word文档中时，刚刚粘贴的内容仍处于“选定”状态。 这意味着任何后续粘贴将有效替换您刚刚插入的内容。 因此，您必须将选择点移动到文档的末尾。

将它们放到一个示例程序中：

Option Explicit

Public Sub ExcelToWord()
    Dim wb As Workbook
    Set wb = ThisWorkbook

    '--- create the Word document
    Dim objWd As Word.Application
    Set objWd = CreateObject("word.application")
    objWd.Visible = True

    Dim objDoc As Word.Document
    Set objDoc = objWd.Documents.Add
    objDoc.PageSetup.Orientation = 1             '  portrait = 0

    Const wdPageBreak As Long = 7

    Dim ws As Worksheet
    For Each ws In wb.Sheets
        ws.UsedRange.Copy
        objWd.Selection.Paste
        '--- advance the selection point to the end of
        '    the document and insert a page break, then
        '    advance the insertion point past the break
        objDoc.Characters.Last.Select
        objWd.Selection.InsertBreak wdPageBreak
        objDoc.Characters.Last.Select
    Next ws
    'objDoc.SaveAs Application.ThisWorkbook.Path & ".\dokument.docx"
End Sub