高手再来解决吧，EXCL表格数据写入WORD文档中的表格中

中华美德

EXCL表格数据写入9张不同姓名的WORD文档中的表格中

493861364

做一个空模板word放在同文件夹下面，模板.doc
空了几行，体力活儿了，自己填上吧，试了一下，

1. Private Sub aa()
   
2.    Dim Wordapp As New Word.Application, path, fname, fullname, i, j
   
3.    path = ThisWorkbook.path
   
4.    lastrow = Sheets("21年").Range("B65536").End(xlUp).Row
   
5.    s = 0
   
6.    For i = 3 To lastrow - 1
   
7.       fname = "三、HS-AQBD-079 事故调查报告 "
   
8.       FileCopy path & "\模板.doc", path & "" & fname & "(" & Sheets("21年").Range("A" & i) & ").doc"
   
9.       fullname = path & "" & fname & "(" & Sheets("21年").Range("A" & i) & ").doc"
   
10.       With Wordapp
    
11.         .Documents.Open fullname
    
12.         .Visible = False
    
13.            .ActiveDocument.Tables(1).Cell(1, 2).Range = Sheets("21年").Cells(i, 1)
    
14.            .ActiveDocument.Tables(1).Cell(1, 4).Range = Sheets("21年").Cells(i, 6)
    
15.            .ActiveDocument.Tables(1).Cell(1, 6).Range = Sheets("21年").Cells(i, 7)
    
16.            .ActiveDocument.Tables(1).Cell(3, 2).Range = Sheets("21年").Cells(i, 3)
    
17.       
    
18.       
    
19.       
    
20.       
    
21.       
    
22.       
    
23.       
    
24.       End With
    
25.       Wordapp.Documents.Save
    
26.       Wordapp.Quit
    
27.       Set Wordapp = Nothing
    
28.    Next i
    
29.    If s = 0 Then
    
30.       MsgBox "已输出到 Word 文件！"
    
31.    End If
    
32. End Sub
    

复制代码

运行正常

Moneky

请用我的Xls2Doc，可以完美解决

中华美德

493861364 发表于 2021-12-3 19:44
做一个空模板word放在同文件夹下面，模板.doc
空了几行，体力活儿了，自己填上吧，试了一下，

中华美德

493861364 发表于 2021-12-3 19:44
做一个空模板word放在同文件夹下面，模板.doc
空了几行，体力活儿了，自己填上吧，试了一下，

谢谢解决，但是不能执行

493861364

中华美德 发表于 2021-12-3 21:04
谢谢解决，但是不能执行

在VBA中，工具-引用，选取“MicroSoft Word 1x.0 Object Library”。

中华美德

493861364 发表于 2021-12-3 21:49
在VBA中，工具-引用，选取“MicroSoft Word 1x.0 Object Library”。

在VBA中，工具-引用，选取“MicroSoft Word 1x.0 Object Library”。不行

493861364

中华美德 发表于 2021-12-3 23:30
在VBA中，工具-引用，选取“MicroSoft Word 1x.0 Object Library”。不行

不行是什么意思，是引用后还不能运行代码？

493861364

Private Sub aa()
   Dim Wordapp As New Word.Application, path, fname, fullname, i, j
   path = ThisWorkbook.path
   lastrow = Sheets("21年").Range("B65536").End(xlUp).Row
   s = 0
   For i = 3 To lastrow - 1
      fname = "三、HS-AQBD-079 事故调查报告 "
      FileCopy path & "\模板.doc", path & "\" & fname & "(" & Sheets("21年").Range("A" & i) & ").doc"
      fullname = path & "\" & fname & "(" & Sheets("21年").Range("A" & i) & ").doc"
      With Wordapp
        .Documents.Open fullname
        .Visible = False
           .ActiveDocument.Tables(1).Cell(1, 2).Range = Sheets("21年").Cells(i, 1)
           .ActiveDocument.Tables(1).Cell(1, 4).Range = Sheets("21年").Cells(i, 6)
           .ActiveDocument.Tables(1).Cell(1, 6).Range = Sheets("21年").Cells(i, 7)
           .ActiveDocument.Tables(1).Cell(3, 2).Range = Sheets("21年").Cells(i, 3)
      
      
      
      
      
      
      
      End With
      Wordapp.Documents.Save
      Wordapp.Quit
      Set Wordapp = Nothing
   Next i
   If s = 0 Then
      MsgBox "已输出到 Word 文件！"
   End If
End Sub

中华美德

493861364 发表于 2021-12-4 08:26
不行是什么意思，是引用后还不能运行代码？

可以了，但是相同姓名只能导出1个，9起事件只能导出7，还有导出需要存放在相司文件夹下面