[已解决]VBA关于WORD文档合并的问题

yjwdjfqb

VBA关于WORD文档合并的问题

老师们好：
这个附件中“合并”文档中的代码，没有按序号顺序来合并文档，合并下一个文档时也没有另起一页合并（就像键盘操作的同时按ctrl+Enter键一样）
现在想修改成：按序号顺序合并文档，合并下一个文档时另起一页合并
请老师们帮帮忙，谢谢老师们了！

附件.rar (38.43 KB, 下载次数: 11)

2016-12-22 23:27 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

today0427

2016-12-23 09:26

1. Sub 合并当前路径下所有WORD文档()
   
2. 
   
3.     Dim Doc As Document, myDoc As Document, myPath$, myName$
   
4.     Set myDoc = ActiveDocument
   
5.     Application.ScreenUpdating = False
   
6.     Selection.WholeStory
   
7.     Selection.Delete Unit:=wdCharacter, Count:=1
   
8.     myPath = myDoc.Path & ""
   
9.     myName = Dir(myPath & "\*.doc")
   
10.     Do While myName <> ""
    
11.         If myName <> myDoc.Name Then
    
12.             Set Doc = Documents.Open(myPath & myName)
    
13.             Selection.WholeStory
    
14.             Selection.Copy
    
15.             myDoc.Activate
    
16.             Selection.PasteAndFormat (wdPasteDefault)
    
17.             Selection.EndKey Unit:=wdStory
    
18.             Selection.InsertBreak Type:=wdPageBreak
    
19.             Doc.Close
    
20.             Set Doc = Nothing
    
21.         End If
    
22.         myName = Dir
    
23.     Loop
    
24.     Application.ScreenUpdating = True
    
25.     Selection.HomeKey Unit:=wdStory    '光标返回文档首
    
26. End Sub
    

复制代码

跳转到最佳答案楼层

today0427

修改了分页符那个，至于按顺序合并，我这里没问题，就是按顺序合并的，你看看文档中的效果就是运行宏后的效果
附件.rar (44.15 KB, 下载次数: 23)

2016-12-22 23:43 上传

点击文件名下载附件

一沫昔阳虹w

today0427 发表于 2016-12-22 23:43
修改了分页符那个，至于按顺序合并，我这里没问题，就是按顺序合并的，你看看文档中的效果就是运行宏后的效 ...

没看到代码，代码在哪呢

today0427

1. Sub 合并当前路径下所有WORD文档()
   
2. 
   
3.     Dim Doc As Document, myDoc As Document, myPath$, myName$
   
4.     Set myDoc = ActiveDocument
   
5.     Application.ScreenUpdating = False
   
6.     Selection.WholeStory
   
7.     Selection.Delete Unit:=wdCharacter, Count:=1
   
8.     myPath = myDoc.Path & ""
   
9.     myName = Dir(myPath & "\*.doc")
   
10.     Do While myName <> ""
    
11.         If myName <> myDoc.Name Then
    
12.             Set Doc = Documents.Open(myPath & myName)
    
13.             Selection.WholeStory
    
14.             Selection.Copy
    
15.             myDoc.Activate
    
16.             Selection.PasteAndFormat (wdPasteDefault)
    
17.             Selection.EndKey Unit:=wdStory
    
18.             Selection.InsertBreak Type:=wdPageBreak
    
19.             Doc.Close
    
20.             Set Doc = Nothing
    
21.         End If
    
22.         myName = Dir
    
23.     Loop
    
24.     Application.ScreenUpdating = True
    
25.     Selection.HomeKey Unit:=wdStory    '光标返回文档首
    
26. End Sub
    

复制代码