关于word文档分割的

dafanshu1

13907933959 发表于 2016-6-24 14:16
前辈好！

我把这几句放在一起运行了。

如果只拿掉oSrcDoc.Activate这句呢？

13907933959

dafanshu1 发表于 2016-6-24 14:41
如果只拿掉oSrcDoc.Activate这句呢？

前辈好！

拿掉了这一句后还会报错，运行时也一样提示错误’4605 ’ 宏运行不了。
oSrcDoc.Activate

dafanshu1

13907933959 发表于 2016-6-24 15:22
前辈好！

拿掉了这一句后还会报错，运行时也一样提示错误’4605 ’ 宏运行不了。

如果单独运行这两句呢：
Documents.Add
ActiveDocument.Bookmarks("\page").Range.Select

13907933959

dafanshu1 发表于 2016-6-24 16:17
如果单独运行这两句呢：
Documents.Add
ActiveDocument.Bookmarks("\page").Range.Select

前辈好！
单独运行了这2句，可运行，并看到新建了一个空白页。
Sub SplitEveryFivePagesAsDocuments()
      Documents.Add
      ActiveDocument.Bookmarks("\page").Range.Select
End Sub

loquat

1. Sub SplitEveryFivePagesAsDocuments()
   
2.     Dim oSrcDoc As Document, oNewDoc As Document
   
3.     Dim strSrcName As String, strNewName As String
   
4.     Dim oRange As Range, tmpRange As Range
   
5.     Dim nIndex As Integer, nSubIndex As Integer, nTotalPages As Integer, nBound As Integer
   
6.     Dim fso As Object
   
7.    
   
8.     Const nSteps = 200         ' 修改这里控制每隔几页分割一次
   
9.    
   
10.     Set fso = CreateObject("Scripting.FileSystemObject")
    
11.     Set oSrcDoc = ActiveDocument
    
12.     Set oRange = oSrcDoc.Content
    
13.    
    
14.     nTotalPages = ActiveDocument.Content.Information(wdNumberOfPagesInDocument)
    
15.     oRange.Collapse wdCollapseStart
    
16.     oRange.Select
    
17.     For nIndex = 1 To nTotalPages Step nSteps
    
18.         Set oNewDoc = Documents.Add
    
19.         If nIndex + nSteps > nTotalPages Then
    
20.             nBound = nTotalPages
    
21.         Else
    
22.             nBound = nIndex + nSteps - 1
    
23.         End If
    
24.         For nSubIndex = nIndex To nBound
    
25.             oSrcDoc.Activate
    
26.             Set tmpRange = oSrcDoc.Bookmarks("\page").Range
    
27.             tmpRange.MoveEnd(wdCharacter,-1)
    
28.             tmpRange.Copy
    
29.             oSrcDoc.Windows(1).Activate
    
30.             Application.Browser.Target = wdBrowsePage
    
31.             Application.Browser.Next
    
32.    
    
33.             oNewDoc.Activate
    
34.             oNewDoc.Windows(1).Selection.Paste
    
35.         Next nSubIndex
    
36.         strSrcName = oSrcDoc.FullName
    
37.         strNewName = fso.BuildPath(fso.GetParentFolderName(strSrcName), _
    
38.                      fso.GetBaseName(strSrcName) & "_" & (nIndex \ nSteps + 1) & "." & fso.GetExtensionName(strSrcName))
    
39.         oNewDoc.SaveAs strNewName
    
40.         oNewDoc.Close False
    
41.     Next nIndex
    
42.     Set oNewDoc = Nothing
    
43.     Set oRange = Nothing
    
44.     Set oSrcDoc = Nothing
    
45.     Set fso = Nothing
    
46.     MsgBox "结束！"
    
47. End Sub

复制代码

loquat

针对此类问题，我也写了一个比较复杂的，可以去批量调用
发现这个代码远没有我下面写的代码那么简单，目前发现在分割位置遇到表格时以下代码处理会有问题。
单个文件调用方式如下：

1. Sub callItYourOwn()
   
2. SplitEveryFewPagesAsDocuments ActiveDocument, 5
   
3. End Sub

复制代码

多个文件调用方式如下：
假设arr里存储的是你待处理的word文件列表

1. Sub callItYourOwn()
   
2. Dim aDoc As Document
   
3. For i = LBound(arr) To UBound(arr)
   
4.     Set aDoc = Documents.Open(arr)
   
5.     SplitEveryFewPagesAsDocuments arr(i), 5
   
6. Next
   
7. End Sub

复制代码

'主程序代码如下：

1. Sub SplitEveryFewPagesAsDocuments(ByVal aDoc As Document, ByVal splitPages&)
   
2. Application.ScreenUpdating = False
   
3. Dim aPageCount&, aSplitTimes&, i&
   
4. Dim aStart&, aEnd&, aFilePath$, aFileName$
   
5. Dim aRange As Range, wdApp As Word.Application
   
6. Set wdApp = GetObject(, "Word.Application")
   
7. aPageCount = aDoc.ComputeStatistics(wdStatisticPages)  '获取目标文档的页数
   
8. If aPageCount <= splitPages Then Exit Sub              '目标文档页数少于分割页数，则退出
   
9. aFilePath = aDoc.Path                                  '获取文件路径
   
10. aFileName = Left(aDoc.Name, InStrRev(aDoc.Name, ".doc") - 1)  '获取文件名
    
11. If Dir(aFilePath & "" & aFileName, vbDirectory) = "" Then    '如果以目标文件名为名称的文件夹不存在
    
12.     MkDir aFilePath & "" & aFileName                         '则新建该文件夹
    
13. End If
    
14. Set aRange = aDoc.Range(0, 0)                          '对象初始化，排除光标移动
    
15. aSplitTimes = -Int(-(aPageCount / splitPages))         '分割后的文档份数
    
16. For i = 1 To aSplitTimes
    
17.     aStart = aRange.GoTo(wdGoToPage, wdGoToAbsolute, i * splitPages).Start  '分割页起始位置
    
18.     If i = aSplitTimes Then
    
19.         aEnd = aDoc.Content.End - 1
    
20.     Else
    
21.         aEnd = aRange.GoTo(wdGoToPage, wdGoToAbsolute, (i + 1) * splitPages).Start - 1
    
22.     End If
    
23.     Set aRange = aDoc.Range(aStart, aEnd)
    
24.     Do While InStr(1, "11121314", Asc(Right(aRange.Text, 1)))  '去掉末尾的所有占位符，换行符，分页符，自动换行符，分栏符，分节符
    
25.         aRange.MoveEnd 1, -1
    
26.     Loop
    
27.     aRange.Copy
    
28.     With wdApp.Documents.add
    
29.         .Content.Text = ""
    
30.         .Content.Paste
    
31.         .SaveAs aFilePath & "" & aFileName & "" & aFileName & "_" & format(i, "000") & Mid(aDoc.Name, InStrRev(aDoc.Name, ".doc"))
    
32.         .Close False
    
33.     End With
    
34. Next i
    
35. If aDoc.FullName = ActiveDocument.FullName Then
    
36.     Exit Sub  '如果是在处理当前文档，直接退出程序
    
37. Else
    
38.     aDoc.Close False  '否则，关闭文档，且不保存退出
    
39. End If
    
40. MsgBox "已完成！！！"
    
41. Application.ScreenUpdating = False
    
42. End Sub

复制代码

loquat

上述代码，第2个参数就是按几页分割1次。还没审核通过，审核通过就可以看到

13907933959

loquat 发表于 2016-6-25 12:57

前辈好！
感谢前辈多次出手相助！
25楼的代码一复制粘贴进代码窗口，这句tmpRange.MoveEnd(wdCharacter,-1)就显示为红色，运行后提示“编译错误，语法错误” 宏运行不了。请前辈再看看，谢谢！

13907933959

loquat 发表于 2016-6-25 13:54
针对此类问题，我也写了一个比较复杂的，可以去批量调用
单个文件调用方式如下：

出错了…

13907933959

loquat 发表于 2016-6-25 13:54
针对此类问题，我也写了一个比较复杂的，可以去批量调用
单个文件调用方式如下：

前辈好！
单个文件调用：运行后提示“运行时错误 ’4608’，数值超出范围” 宏运行不了。进代码窗口查看、空箭头指向该句Set aRange = aDoc.Range(aStart, aEnd)代码，代码为黄色突出显示状。

多个文件调用：运行后提示“运行时错误 ’13’，类型不匹配” 宏运行不了。进代码窗口查看、空箭头指向该句For i = LBound(Arr) To UBound(Arr)代码，代码为黄色突出显示状。 请前辈再看看，谢谢！