Word用VBA代码每页拆分为一个文档

1、打开Word表格

2、按alt+f11，打开VBA编辑器

3、然后插入模块

4、粘贴以下代码

Option   Explicit         Sub SplitEveryFivePagesAsDocuments()         On Error Resume Next         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 = 1             Set fso = CreateObject("Scripting.FileSystemObject")     Set oSrcDoc = ActiveDocument     Set oRange = oSrcDoc.Content             nTotalPages =   Val(ActiveDocument.BuiltInDocumentProperties(wdPropertyPages))     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             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    

5、单击执行按钮

6、确定结束

7、即可看到同文件目录下，生成3个文档

8、打开其中一个即为拆分的文档