【原】【源代码】Word VBA按任意页拆分文档

具体需求

每2页拆分一下Word文档

通用代码

思路：遍历文档所有页，隔几页开始挨着复制每页内容，复制到新的文档中。

Sub SplitPagesAsDocuments() Dim oSrcDoc As Document, oNewDoc As Document Dim strSrcName As String, strNewName As String Dim oRange As Range Dim nIndex As Integer, nSubIndex As Integer, nTotalPages As Integer, nBound As Integer Dim fso As Object Const nSteps = 2 ' 修改这里控制每隔几页分割一次 Set fso = CreateObject("Scripting.FileSystemObject") Set oSrcDoc = ActiveDocument Set oRange = oSrcDoc.Content nTotalPages = ActiveDocument.Content.Information(wdNumberOfPagesInDocument) '利用Information属性获取活动文档中的总页码 oRange.Collapse wdCollapseStart oRange.Select '光标定位到文档开头 For nIndex = 1 To nTotalPages Step nSteps Set oNewDoc = Documents.Add If nIndex + nSteps > nTotalPages Then nBound = nTotalPages Else nBound = nIndex + nSteps - 1 End If For nSubIndex = nIndex To nBound '循环复制范围中的每页内容 oSrcDoc.Activate oSrcDoc.Bookmarks("\page").Range.Copy '对当前页复制 oSrcDoc.Windows(1).Activate Application.Browser.Target = wdBrowsePage Application.Browser.Next oNewDoc.Activate oNewDoc.Windows(1).Selection.Paste oNewDoc.Application.Selection.EndKey wdStory oNewDoc.Application.Selection.Delete wdCharacter, -1 '为了避免拆分后有多余的空白页，向前删除1个位置 Next nSubIndex strSrcName = oSrcDoc.FullName strNewName = fso.BuildPath(fso.GetParentFolderName(strSrcName), _ fso.GetBaseName(strSrcName) & "_" & (nIndex \ nSteps + 1) & "." & fso.GetExtensionName(strSrcName)) oNewDoc.SaveAs strNewName oNewDoc.Close False Next nIndex Set oNewDoc = Nothing Set oRange = Nothing Set oSrcDoc = Nothing Set fso = Nothing MsgBox "结束！"End Sub

知识点

• Information属性

◎作用：

'返回有关指定的所选内容或区域的信息。

◎用法:

表达式.Information(Type)

'Type代表WdInformation，必需。消息类型。具体含义查帮助

◎案例:

'获取当前页码和总页码。

Sub 获取当前页码和总页码() MsgBox Selection.Information(wdActiveEndPageNumber) MsgBox Selection.Information(wdNumberOfPagesInDocument)End Sub

'判断光标是否位于表格中

Sub 判断光标是否位于表格中()    If Selection.Information(wdWithInTable) = True Then        MsgBox "光标位于表格中"    Else        MsgBox "光标不位于表格中"    End IfEnd Sub

• EndKey方法

一般结合Slection。用Selection.EndKey 。

◎作用：

'将选定内容移动或扩展到指定单位的末尾。

◎用法:

表达式.EndKey(Unit, Extend)

'Unit 可选参数 移动或扩展选定内容时基于的单位。可以是 WdUnits 常量之一。默认值为 wdLine。

'可以是下列 WdUnits 常量之一：

    'wdStory

    'wdColumn

    'wdLine

    'wdRow 默认值是 wdLine

'Extend 可选参数 指定移动所选内容的方式。可以是任意 WdMovementType 常量。

'如果该参数值为 wdMove，则所选内容折叠到一个插入点中并移至指定单位的末尾。如果该参数值为 wdExtend，则所选内容的末尾扩展到指定单位的末尾，默认值为 wdMove。

◎案例:

'向文章开头写入内容。

Sub 向文章开头写入内容() ActiveDocument.Range(0, 0).Select Selection.TypeText "这是文章开头" Selection.homekey wdStory Selection.TypeText "这是文章开头"End Sub

'向文章末尾写入内容

Sub 向文章末尾写入内容() ActiveDocument.Range(ActiveDocument.Range.End - 1, ActiveDocument.Range.End).Select Selection.TypeText "这是文章末尾" Selection.EndKey wdStory Selection.TypeText "这是文章开头"End Sub

更多WordVBA知识，详见《WordVBA精讲课》