word插入对象时如何换页？

sblisb

有多个word文件想用插入对象功能插到到文档中，如何让每个插入的文件内容另起一页呀？

daibao88

插入对象、分页符、对象、分页符.....

sblisb

daibao88 发表于 2019-6-6 15:45
插入对象、分页符、对象、分页符.....

这个太慢了呀，我有100多个文件，我原来是用插入-对象-对象中的文字，内容是全插入进来了，可我想每个文件内容另起一页，要一个个去插入分页符，有什么好办法吗？

daibao88

vba循环去做，代替手工

sblisb

daibao88 发表于 2019-6-6 15:57
vba循环去做，代替手工

那能不能帮忙写个代码，调用插入对象——对象中的文字功能，然后我添加点需要的代码在后面，
录制的宏不好用，只能指定路径下的文件。

daibao88

参考http://club.excelhome.net/thread-1470790-1-1.html  7楼

413191246se

略。。。。。

sblisb

413191246se 发表于 2019-6-7 14:54
楼主，由于水平较低，Dir 函数 不太会，现在给出一个初级代码。请认真观看代码中注释，并请注意：双击进入 ...

谢谢！不能用呀，点击文件夹后没有反应

413191246se

1. Sub FSO批量插入文档()
   
2. 
   
3.     If Documents.Count = 0 Then MsgBox "没有打开的文档！", 0 + 16: End
   
4. 
   
5.     With Selection
   
6.         .EndKey 6
   
7.         .InsertBreak 2
   
8.     End With
   
9. 
   
10.     On Error Resume Next
    
11. 
    
12.     Dim objShell As Object, objFolder As Object, pPath$, f As Object, fd As Object, fso As Object, Stack$(), top&, n&, stxt$, doc As Document, x&
    
13. 
    
14.     Set objShell = CreateObject("Shell.Application")
    
15.     Set objFolder = objShell.BrowseForFolder(0, "请选择要插入的文件夹！", 0, 0)
    
16. 
    
17.     pPath = objFolder.self.Path & ""
    
18. 
    
19.     Set objShell = Nothing
    
20.     Set objFolder = Nothing
    
21. 
    
22.     If MsgBox("请确认！是否插入文件夹 " & pPath & " ?", 4 + 16) = vbNo Then ActiveDocument.Close 0: Exit Sub
    
23. 
    
24.     Set fso = CreateObject("Scripting.FileSystemObject")
    
25. 
    
26.     top = 1
    
27.     ReDim Stack(0 To top)
    
28. 
    
29.     Do While top >= 1
    
30.         For Each f In fso.GetFolder(pPath).Files
    
31.             n = n + 1
    
32.             stxt = f.Path
    
33.             If stxt Like "*.doc*" Then
    
34.                 With Selection
    
35.                     .InsertFile FileName:=stxt
    
36.                     .InsertBreak Type:=wdSectionBreakNextPage
    
37.                 End With
    
38.                 x = x + 1
    
39.             End If
    
40.         Next
    
41.         For Each fd In fso.GetFolder(pPath).SubFolders
    
42.             Stack(top) = fd.Path
    
43.             top = top + 1
    
44.             If top > UBound(Stack) Then ReDim Preserve Stack(0 To top)
    
45.         Next
    
46.         If top > 0 Then pPath = Stack(top - 1): top = top - 1
    
47.     Loop
    
48. 
    
49.     Set f = Nothing
    
50.     Set fd = Nothing
    
51.     Set fso = Nothing
    
52. 
    
53.     With ActiveDocument
    
54.         .Range(Start:=.Content.End - 2, End:=.Content.End - 2).Select
    
55.     End With
    
56.     With Selection
    
57.         .Delete
    
58.         .Delete
    
59.         .HomeKey 6
    
60.     End With
    
61. 
    
62.     MsgBox "文件夹包含 " & n & " 个文件！" & vbCr & "共插入 Word 文档(*.docx/*.doc) " & x & " 个！", 0 + 48
    
63. End Sub

复制代码