怎么把多个word文档合并为一个

VBA万岁

陈文华 发表于 2015-9-21 18:37
真是麻烦老师了，不行，太难了，学不了啊。

再将16楼的代码收入功能区如附件：
主文件.zip (237.11 KB, 下载次数: 168)

2015-9-22 09:41 上传

点击文件名下载附件

陈文华

VBA万岁 发表于 2015-9-22 09:41
再将16楼的代码收入功能区如附件：

老师你好，你真是高手，我虽然不常用WORD文档，可我有收藏的习惯，用时就拿出来用，真方便。我一般使用EXCEL，水平也一般般。

VBA万岁

VBA万岁 发表于 2015-9-22 09:41
再将16楼的代码收入功能区如附件：

代码：
Word代码：

1. Sub pCopy(control As IRibbonControl)
   
2.     Dim p$, f$, w As Object
   
3.     Application.Visible = False
   
4.     Set w = ActiveDocument
   
5.     p = w.Path & ""
   
6.     Selection.WholeStory
   
7.     Selection.Delete Unit:=wdCharacter, count:=1
   
8.     f = Dir(p & "*.doc")
   
9.     Do While f <> ""
   
10.         If f <> w.Name Then
    
11.             With Documents.Open(p & f)
    
12.                 Selection.WholeStory
    
13.                 Selection.Copy
    
14.                 w.Activate
    
15.                 Selection.PasteAndFormat (wdPasteDefault)
    
16.                 .Close
    
17.             End With
    
18.         End If
    
19.         f = Dir
    
20.     Loop
    
21.     Application.Visible = True
    
22. End Sub
    
23. 
    
24. Sub SplitPagesAsDocuments(control As IRibbonControl)
    
25. Dim oSrcDoc As Document, oNewDoc As Document
    
26. Dim strSrcName As String, strNewName As String
    
27. Dim oRange As Range
    
28. Dim nIndex As Integer
    
29. Dim fso As Object
    
30. 
    
31. On Error Resume Next
    
32. Set fso = CreateObject("Scripting.FileSystemObject")
    
33. Set oSrcDoc = ActiveDocument
    
34. Set oRange = oSrcDoc.Content
    
35. oRange.Collapse wdCollapseStart
    
36. oRange.Select
    
37. For nIndex = 1 To ActiveDocument.Content.Information(wdNumberOfPagesInDocument)
    
38.     oSrcDoc.Bookmarks("\page").Range.Copy
    
39.     oSrcDoc.Windows(1).Activate
    
40.     Application.Browser.Target = wdBrowsePage
    
41.     Application.Browser.Next
    
42. 
    
43.     strSrcName = oSrcDoc.FullName
    
44.     strNewName = fso.BuildPath(fso.GetParentFolderName(strSrcName), _
    
45.     fso.GetBaseName(strSrcName) & "_" & nIndex & "." & _
    
46.     fso.GetExtensionName(strSrcName))
    
47.     Set oNewDoc = Documents.Add
    
48.     Selection.Paste
    
49.     oNewDoc.SaveAs Mid(strNewName, 1, Len(strNewName) - 1)
    
50.     oNewDoc.Close False
    
51. Next
    
52. Set oNewDoc = Nothing
    
53. Set oRange = Nothing
    
54. Set oSrcDoc = Nothing
    
55. Set fso = Nothing
    
56. MsgBox "结束！"
    
57. End Sub

复制代码

VBA万岁

VBA万岁 发表于 2015-9-22 09:41
再将16楼的代码收入功能区如附件：

功能区代码：

1. <customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui" >
   
2. <ribbon>
   
3. <tabs>
   
4.   <tab id="TabChange1"  label="Word工具箱"  insertAfterMso="TabHome">
   
5. 
   
6. 
   
7.           <group id="myGroup1" label="复制">
   
8.               <button id="b1"
   
9.                       imageMso="CreateReportFromWizard"
   
10.                       size="large"
    
11.                       label="批量复制"
    
12.                       onAction="pCopy"/>
    
13.           </group>
    
14.   </tab>
    
15. </tabs>
    
16. </ribbon>
    
17. </customUI>
    

复制代码

mmwwdd

嗯，word VBA 的书太少，想学一下

野路子2010

高手太多了

kszcs

收藏了，这个很实用

鄂龙蒙

zhaogang1960 发表于 2014-5-26 22:49
复制、粘贴录制宏：

请教：http://club.excelhome.net/thread-1318059-1-1.html

zhgfeng1988

zhaogang1960 发表于 2014-5-26 22:49
复制、粘贴录制宏：

请问一下，这段代码在运用过程中有没有什么需要注意的，还有怎么能决定各文档在新的合并文档中的顺序。

袁子亚

系统一点的关于Word VBA的书极少，找过好久，就只看到有一本英文专辑，可惜又看不懂~  希望大神出书