【源代码】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精讲课》