|
|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
本帖最后由 13907933959 于 2016-3-22 11:37 编辑
网友好！
这个是一个前辈编写的宏，在下借花献佛，希望能帮到你！
注：用这个宏时，先把要拆分的文档放进一个空白的文件夹内，然后再打开文件夹内要拆分的文档，点文档内上面的“工具”→“宏”→“宏”→找到这个宏→“运行”即可。原文档和拆分后的小文档都会在这个文件夹内。拆分后的小文档文件名的后面会有编号。
Sub 把大文档拆分成小文档的宏()
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 = ActiveDocument.Content.Information(wdNumberOfPagesInDocument)
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
|
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2016-3-21 16:50
楼主