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