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

Posted 2023-05-07

【中文标题】Excel VBA：将工作簿另存为 Word 文档

【英文标题】：Excel VBA: Save workbook as Word document

【发布时间】：2017-12-08 07:40:41

【问题描述】：

我想将我的工作簿（所有工作表）保存为一个 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

感谢您的回复。

【问题讨论】：

代码似乎只是在进行复制/粘贴，因此只需在进行保存之前遍历每个工作表进行复制/粘贴。

是的，我也这么认为，但我的脚本只保存最后一页（工作表）。 n = Sheets.Count For i = 1 To n Sheets(i).UsedRange.Copy objDoc.Content.Paste Next i

【参考方案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