簡単に書けるだろうと思ったら異様なほど手間取った。
Option Explicit Private Sub PageSplitButton_Click() Dim pageCount As Integer: pageCount = Selection.Information(WdInformation.wdNumberOfPagesInDocument) Dim saveCount As Integer: saveCount = 0 Dim i As Integer Dim targetDocument As Document: Set targetDocument = ActiveDocument MsgBox targetDocument.Name & "を処理します(" & pageCount & "ページ)" Dim originalViewType As Long: originalViewType = targetDocument.ActiveWindow.View.Type targetDocument.ActiveWindow.View.Type = wdNormalView For i = 1 To pageCount Step 1 Dim topOfPage As Range: Set topOfPage = targetDocument.GoTo(WdGoToItem.wdGoToPage, , i) Dim endOfPage As Range: Set endOfPage = targetDocument.GoTo(WdGoToItem.wdGoToPage, , (i + 1)) Dim topPos As Long: topPos = topOfPage.Start Dim endPos As Long: endPos = endOfPage.Start - 1 If (i >= pageCount) Then endPos = targetDocument.Content.End - 1 End If Dim length As Long: length = endPos - topPos If (length > 0) Then ' MsgBox targetDocument.Name & "のページ" & i & "を処理" Dim pageRange As Range: Set pageRange = targetDocument.Range(topPos, endPos) Dim newDocument As Document: Set newDocument = Documents.Add() newDocument.Select pageRange.Copy Selection.Paste Dim newDocumentPath As String: newDocumentPath = targetDocument.Path Dim newDocumentName As String: newDocumentName = targetDocument.Name & "_splitted_" & i & "_of_" & pageCount & ".doc" Call newDocument.SaveAs(targetDocument.Path & "\" & newDocumentName) newDocument.Close saveCount = saveCount + 1 End If Next targetDocument.ActiveWindow.View.Type = originalViewType DoEvents MsgBox targetDocument.Name & "を処理しました(" & saveCount & "/" & pageCount & "ページ)" Me.Hide End Sub