[已解决]Excel与Word数据交互问题

yjwdjfqb

Excel与Word数据交互问题
实例1，是将每人生成一个单独的WORD文档（运行宏代码即可查看效果）

现在想在实例2中修改成，把所有人员生成在一个WORD文档中（文档的名称为“干部审批表”）
请老师们帮帮忙，谢谢老师们了！
附件.rar (42.65 KB, 下载次数: 2)

2016-12-21 12:55 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

苏子龙

2016-12-21 15:04

1. http://club.excelhome.net/thread-477904-1-1.html
   
2. Sub tt()
   
3.     Dim arr, i As Integer
   
4.     Dim pic As String
   
5.     Dim Word对象 As New Word.Application
   
6.     Dim s As Integer
   
7.     Dim strPath$
   
8.     Dim newWord$, EndRow%
   
9.     arr = Range("A1").CurrentRegion.Value
   
10.     EndRow = UBound(arr)
    
11.     strPath = ThisWorkbook.Path & ""
    
12.     newWord = ThisWorkbook.Path & "\干部审批表.doc"
    
13.     FileCopy strPath & "模板.doc", newWord
    
14.     With Word对象
    
15.         .Documents.Open newWord
    
16.         .Visible = False
    
17.         .ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument '设置位置在正文
    
18.         .Selection.WholeStory '全选
    
19.         .Selection.Copy '复制
    
20.         If EndRow > 3 Then
    
21.             For i = 2 To EndRow - 1 '复制页
    
22.                 .Selection.EndKey Unit:=wdStory '光标置于文件尾
    
23.                 .Selection.InsertBreak Type:=wdPageBreak '分页
    
24.                 .Selection.PasteAndFormat (wdPasteDefault) '粘贴
    
25.             Next i
    
26.         End If
    
27.         For i = 2 To EndRow '循环将数据写入表格内
    
28.             Application.StatusBar = arr(i, 1)
    
29.             .ActiveDocument.Tables(i * 2 - 3).Cell(1, 2).Range = Cells(i, "C") '姓名列bookmarks("姓名")
    
30.             .ActiveDocument.Tables(i * 2 - 3).Cell(1, 4).Range = Cells(i, "G")  'bookmarks("性别")
    
31.             .ActiveDocument.Tables(i * 2 - 3).Cell(1, 6).Range = Cells(i, "K")  'bookmarks("年龄")
    
32.         Next i
    
33.         .Documents.Save
    
34.         .Quit
    
35.     End With
    
36.     Application.StatusBar = ""
    
37.     MsgBox "整理完成", , "提示"
    
38. End Sub
    

复制代码

跳转到最佳答案楼层

苏子龙

1. http://club.excelhome.net/thread-477904-1-1.html
   
2. Sub tt()
   
3.     Dim arr, i As Integer
   
4.     Dim pic As String
   
5.     Dim Word对象 As New Word.Application
   
6.     Dim s As Integer
   
7.     Dim strPath$
   
8.     Dim newWord$, EndRow%
   
9.     arr = Range("A1").CurrentRegion.Value
   
10.     EndRow = UBound(arr)
    
11.     strPath = ThisWorkbook.Path & ""
    
12.     newWord = ThisWorkbook.Path & "\干部审批表.doc"
    
13.     FileCopy strPath & "模板.doc", newWord
    
14.     With Word对象
    
15.         .Documents.Open newWord
    
16.         .Visible = False
    
17.         .ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument '设置位置在正文
    
18.         .Selection.WholeStory '全选
    
19.         .Selection.Copy '复制
    
20.         If EndRow > 3 Then
    
21.             For i = 2 To EndRow - 1 '复制页
    
22.                 .Selection.EndKey Unit:=wdStory '光标置于文件尾
    
23.                 .Selection.InsertBreak Type:=wdPageBreak '分页
    
24.                 .Selection.PasteAndFormat (wdPasteDefault) '粘贴
    
25.             Next i
    
26.         End If
    
27.         For i = 2 To EndRow '循环将数据写入表格内
    
28.             Application.StatusBar = arr(i, 1)
    
29.             .ActiveDocument.Tables(i * 2 - 3).Cell(1, 2).Range = Cells(i, "C") '姓名列bookmarks("姓名")
    
30.             .ActiveDocument.Tables(i * 2 - 3).Cell(1, 4).Range = Cells(i, "G")  'bookmarks("性别")
    
31.             .ActiveDocument.Tables(i * 2 - 3).Cell(1, 6).Range = Cells(i, "K")  'bookmarks("年龄")
    
32.         Next i
    
33.         .Documents.Save
    
34.         .Quit
    
35.     End With
    
36.     Application.StatusBar = ""
    
37.     MsgBox "整理完成", , "提示"
    
38. End Sub
    

复制代码