标题可能不是很恰当,准确的来说就是将一个有很多页面的Word文档按照指定的页数分解为多个独立的Word文档。本来想通过复制指定页内容然后再新建Word来实现的,后来发现这样做一是很麻烦,二是格式容易错。最后想到了一个比较笨的办法:复制一份原稿,然后除了要保留的页面外,其余的统统删去,然后下个页面再复制一份,以此反复,直到完成全部的拆分。
对于页面的删除,可以通过先选中这个页面内容,然后再执行Selection.Delete方法。这样删除不需要的页面后留下的就是我们需要保留的页面了,这份文档算是完成。
这里有个需要注意的地方,保留Word文档N页中第M页共P页,需要执行两步删除,第一步是删除M页之前的所有页面,第二步是删除M+P页之后的所有页面,然后得到的就是所要的。细节方面就是当执行第一步后,第M页会自动转为第1页(因为前面的都删除了),所以我们接下来执行第二步的时候需要从第1+P页开始,另外如果M=1,说明需要保留从第一页开始,那么第一步可以略去,如果M+P>=总页数,则说明需要保留的包含最后一页,那么第二步就可以略去。
下面提供一份VBScript Class msoWord_SplitPages,其中演示了上面的算法思路,供大家参考:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 | ' ' Description: VBScript/VBS/VBA ' split single word document ' to multi-documents by pages ' Author: wangye <pcn88 at hotmail dot com> ' Website: http://wangye.org ' Copyright by author ' Const PrevPage = 0 Const NextPage = 1 Class msoWord_SplitPages Private m_nFromPage Private m_nToPage Private m_nTotalPages Private m_nPageWidth Private m_wdApp Private m_strFileName Private m_strDestFilePath Private m_nPageSkipWidth Private Sub Class_Initialize() Set m_wdApp = WSH.CreateObject("Word.Application") m_wdApp.Visible = True m_nPageSkipWidth = 0 m_nPageWidth = 1 m_nFromPage = 1 m_nToPage = 0 End Sub Private Sub Class_Terminate() m_wdApp.Visible = True m_wdApp.Quit Set m_wdApp = Nothing End Sub Private Function getTotalPages(filename) Const wdNumberOfPagesInDocument = 4 Dim doc Set doc = m_wdApp.Documents.Open(filename) getTotalPages = _ m_wdApp.Selection.Information(wdNumberOfPagesInDocument) doc.Close Set doc = Nothing End Function Private Function isPagesValid() isPagesValid = CBool(m_nFromPage<=m_nToPage And _ m_nFromPage>0 And m_nToPage<=m_nTotalPages) End Function ' keepPage Need keep pages ' t delete type PrevPage or Next Page Private Sub deletePages(keepPage, t) Const wdGoToPage = 1 Const wdGoToNext = 2 Const wdStory = 6 Dim Range,Selection Dim Range1, Range2 If Not isPagesValid() Then Exit Sub If t=PrevPage And keepPage<1 Then Exit Sub If t=NextPage And keepPage>m_nTotalPages Then Exit Sub Set Selection = m_wdApp.Selection Set Range = m_wdApp.Selection.Range Selection.GoTo wdGoToPage, wdGoToNext, keepPage Selection.Select Set Range1 = Selection.Range If t=PrevPage Then Selection.HomeKey wdStory Else Selection.EndKey wdStory End If Selection.Select Set Range2 = Selection.Range If t=PrevPage Then Range.Start = Range2.Start Range.End = Range1.End Else Range.Start = Range1.Start Range.End = Range2.End End If Range.Select Selection.Delete Selection.TypeBackspace Set Range2 = Nothing Set Range1 = Nothing Set Range = Nothing Set Selection = Nothing End Sub Private Function min_(a, b) If a>b Then min_ = b Else min_ = a End If End Function ' 设置拆分页面的起始页数(初始为1) Public Sub setFromPage(p) m_nFromPage = p End Sub ' 设置拆分页面的末尾页数(初始为总页数) Public Sub setToPage(p) m_nToPage = p End Sub ' 设置每次拆分所需要保留的页数 Public Sub setPageWidth(p) m_nPageWidth = p End Sub ' 设置执行拆分跳过的页数 Public Sub setPageSkipWidth(p) m_nPageSkipWidth = p End Sub ' 设置源Word文件路径 Public Sub setFileName(fn) m_strFileName = fn End Sub ' 设置拆分后的多个Word文件所在的文件夹 Public Sub setDestFilePath(fn) m_strDestFilePath = fn End Sub ' 执行函数 Public Function execute() execute = False m_nTotalPages = getTotalPages(m_strFileName) If m_nToPage <1 Then m_nToPage = m_nTotalPages If Not isPagesValid() Then Exit Function Dim i,fso,doc Set fso = WSH.CreateObject("Scripting.FileSystemObject") If m_strFileName="" Or (Not fso.FileExists(m_strFileName)) Then Exit Function End If If m_strDestFilePath="" Or (Not fso.FolderExists(m_strDestFilePath)) Then m_strDestFilePath = fso.GetParentFolderName(m_strFileName) End If Dim strTempFileName For i=m_nFromPage To _ min_(m_nToPage, m_nTotalPages) Step m_nPageSkipWidth+1 ' 复制一份临时文档供我们删减 strTempFileName = m_strDestFilePath & "\~$tmp" & i & fso.GetTempName fso.CopyFile m_strFileName, strTempFileName Set doc = m_wdApp.Documents.Open(strTempFileName) If i>1 Then deletePages i-1, PrevPage End If If (i+m_nPageWidth-1)<m_nTotalPages Then deletePages m_nPageWidth, NextPage End If doc.Save doc.Close Set doc = Nothing ' 将处理完的临时文档按页码复制回指定文件夹 fso.MoveFile strTempFileName, m_strDestFilePath & "\" & i & ".doc" Next Set fso = Nothing execute = True End Function End Class |
上面的VBS会要求拆分的页码范围,一般不指定的话就意味着整个文档作为拆分对象(从第一页到最后一页),如果未指定ToPage终止页,那么将默认为这个文档的最后一页,脚本需要打开一次文档并利用wdNumberOfPagesInDocument来决定文档总页数。接下来给个调用例子:
Dim obj Set obj = New msoWord_SplitPages obj.setPageWidth 2 obj.setPageSkipWidth 1 obj.setFileName "D:\src\test.doc" obj.setDestFilePath "D:\dest" MsgBox obj.execute Set obj = Nothing |
上述代码将拆分test.doc的第1,2页、第3,4页等等为单独的Word文档,这里拆分的方式由PageWidth和PageSkipWidth决定,因为PageWidth是2所以一次拆分2页,PageSkipWidth设为1决定了第一次从第1页开始,那么第二次就应该从第3页开始,默认PageSkipWidth为0,也就是第一次从第1页开始,第二次就从第2页开始了。当然关于这个操作的逆操作就是将多个Word文档合并成一个文档,可以参考《VBScript/VBA批量合并多个Word文件到一个文件》。好了,代码已经放到github的gist上了,欢迎交流。