按指定页数动态拆分Word文档，这样的Word拆分真是太实用了！ / 四六文摘

Excel情报局

Excel职场联盟

生产挖掘分享Excel基础技能

Excel爱好者大本营

用1%的Excel基础搞定99%的职场问题

做一个超级实用的Excel公众号

Excel是门手艺玩转需要勇气

数万Excel爱好者聚集地

SUPER EXCEL MAN

前言｜职场实例

我们在本月13号的文章中介绍了“如何将一个Word文档按页拆分成多个独立文档”的方法，具体操作方法可以查阅本月13号的详细推文链接：

将一个Word文档按页拆分成多个独立文档，同事1天的工作量，你只要半分钟！

文章刚发布不久，就有粉丝留言咨询：

如何按指定页数动态拆分Word文档？也就是说上述方法是按单页拆分的，如果想按照指定页数拆分，比如说按每2页进行拆分，该如何批量操作完成呢？

通过这个需求我们发现，职场办公中我们遇到的问题好像是千变万化的，永远都有新的问题出现，但是只要我们学会举一反三，储备知识，就可以解决这样的问题。

如下图所示：

在一个文件夹内存放了一个需要拆分的Word文档，名称为“Excel情报局总表”，内含4页文档，4页内容分别为一首宋词，如下图所示：

我们的需求是：

每2页拆分为一个独立的Word文档，即最后拆分为2个独立的Word文档，每个Word文档中显示2页内容，每页内容为1首宋词内容。具体效果如下图所示：

步骤｜解决方案

在文件夹内打开那个需要按页拆分的文档（本例中它的文件名叫做“Excel情报局总表”）

点击“开发工具”选项卡，接着点击"visual basic，进入VBA编辑器，或者键入ALT+F11打开VBA编辑器。点击“插入-模块”，新建一个模块用于编辑输入VBA代码。

将下面一段VBA代码复制粘贴到该新建的模块中。点击上方的“运行-运行子过程/窗体”，稍等几秒会弹出一个拆分成功结束的提示框。点击“确定”按钮。

代码如下：

Option ExplicitSub DynamicSplitPagesAsDocuments()Dim oSrcDoc As Document, oNewDoc As DocumentDim strSrcName As String, strNewName As StringDim oRange As RangeDim nIndex As Integer, nSubIndex As Integer, nTotalPages As Integer, nBound As IntegerDim fso As ObjectConst nSteps = 2Set fso = CreateObject("Scripting.FileSystemObject")Set oSrcDoc = ActiveDocumentSet oRange = oSrcDoc.ContentnTotalPages = ActiveDocument.Content.Information(wdNumberOfPagesInDocument)oRange.Collapse wdCollapseStartoRange.SelectFor nIndex = 1 To nTotalPages Step nStepsSet oNewDoc = Documents.AddIf nIndex + nSteps > nTotalPages ThennBound = nTotalPagesElsenBound = nIndex + nSteps - 1End IfFor nSubIndex = nIndex To nBoundoSrcDoc.ActivateoSrcDoc.Bookmarks("\page").Range.CopyoSrcDoc.Windows(1).ActivateApplication.Browser.Target = wdBrowsePageApplication.Browser.NextoNewDoc.ActivateoNewDoc.Windows(1).Selection.PasteNext nSubIndexstrSrcName = oSrcDoc.FullNamestrNewName = fso.BuildPath(fso.GetParentFolderName(strSrcName), _fso.GetBaseName(strSrcName) & "_" & (nIndex \ nSteps) & "." & fso.GetExtensionName(strSrcName))oNewDoc.SaveAs strNewNameoNewDoc.Close FalseNext nIndexSet oNewDoc = NothingSet oRange = NothingSet oSrcDoc = NothingSet fso = NothingMsgBox "结束!"End Sub

最后关闭VBA窗口，再关闭Word文档。然后打开进入文件夹，我们发现已经拆分完成了，出现了2个独立的Word文档。