Excel的内容填写到word文档

gerogeedward

excel 的内容填写到word中，按图片内容填写，

whuihui

4.87 NJi:/ 复制打开抖音，看看【经典歌曲收集者的作品】律师、法务专员的最爱，签订格式协议不再难！# of... https://v.douyin.com/h6JfAJj/

kucoor

批量用邮件合并岂不更好

3190496160

不是不可以做到，但是，
1、是不是excel中每一行生成一个word，如果是，word文档如何命名？如果不是，又如何命名？
2、word中的很多项，在excel中没有，如何处理？？

gerogeedward

Private Sub gdffzydsatx_Click()
   Dim Word对象 As New Word.Application, 当前路径, 导出文件名, 导出路径文件名, 数据名
   Dim i, j
   Dim Str1, Str2
   当前路径 = ThisWorkbook.Path
   数据表名 = "piliangshuju"
   最后行号 = Sheets(数据表名).Range("B65536").End(xlUp).Row
   判断 = 0
   For i = 2 To 最后行号
      导出文件名 = "工程付款申请单"
      FileCopy 当前路径 & "\机械设备退场确认单(样表).doc", 当前路径 & "\" & 导出文件名 & "(" & Sheets(数据表名).Range("B" & i) & ").doc"
      导出路径文件名 = 当前路径 & "\" & 导出文件名 & "(" & Sheets(数据表名).Range("B" & i) & ").doc"
      With Word对象
         .Documents.Open 导出路径文件名
         .Visible = False
         '******************为便于理解和移植代码，这里就不采用循环的方法了！***************************
         '填写文字数据
         Str1 = "数据1"
         Str2 = Sheets(数据表名).Cells(i, 3)
         .Selection.HomeKey Unit:=wdStory '光标置于文件首
         If .Selection.Find.Execute(Str1) Then '查找到指定字符串
            .Selection.Text = Str2 '替换字符串
            .Selection.Font.Color = wdColorAutomatic '字符为自动颜色
         End If
        
         Str1 = "数据2"
         Str2 = Sheets(数据表名).Cells(i, 4)
         .Selection.HomeKey Unit:=wdStory '光标置于文件首
         If .Selection.Find.Execute(Str1) Then '查找到指定字符串
            .Selection.Text = Str2 '替换字符串
            .Selection.Font.Color = wdColorAutomatic '字符为自动颜色
         End If
         
         Str1 = "数据3"
         Str2 = Sheets(数据表名).Cells(i, 5)
         .Selection.HomeKey Unit:=wdStory '光标置于文件首
         If .Selection.Find.Execute(Str1) Then '查找到指定字符串
            .Selection.Text = Str2 '替换字符串
            .Selection.Font.Color = wdColorAutomatic '字符为自动颜色
         End If
         

         
         Str1 = "数据4"
         Str2 = Sheets(数据表名).Cells(i, 22)
         .Selection.HomeKey Unit:=wdStory '光标置于文件首
         If .Selection.Find.Execute(Str1) Then '查找到指定字符串
            .Selection.Text = Str2 '替换字符串
            .Selection.Font.Color = wdColorAutomatic '字符为自动颜色
         End If
         
                  
         Str1 = "数据5"
         Str2 = Sheets(数据表名).Cells(i, 9)
         .Selection.HomeKey Unit:=wdStory '光标置于文件首
         If .Selection.Find.Execute(Str1) Then '查找到指定字符串
            .Selection.Text = Str2 '替换字符串
            .Selection.Font.Color = wdColorAutomatic '字符为自动颜色
         End If
         
         Str1 = "数据6"
         Str2 = Sheets(数据表名).Cells(i, 10)
         .Selection.HomeKey Unit:=wdStory '光标置于文件首
         If .Selection.Find.Execute(Str1) Then '查找到指定字符串
            .Selection.Text = Str2 '替换字符串
            .Selection.Font.Color = wdColorAutomatic '字符为自动颜色
         End If
         
         Str1 = "数据7"
         Str2 = Sheets(数据表名).Cells(i, 23)
         .Selection.HomeKey Unit:=wdStory '光标置于文件首
         If .Selection.Find.Execute(Str1) Then '查找到指定字符串
            .Selection.Text = Str2 '替换字符串
            .Selection.Font.Color = wdColorAutomatic '字符为自动颜色
         End If
         
         '''''++++++++++++++++++++++++++++++++++++++++++++++++++++++++
         Str1 = "数据8"
         Str2 = Sheets(数据表名).Cells(i, 17)
         .Selection.HomeKey Unit:=wdStory '光标置于文件首
         If .Selection.Find.Execute(Str1) Then '查找到指定字符串
            .Selection.Text = Str2 '替换字符串
            .Selection.Font.Color = wdColorAutomatic '字符为自动颜色
         End If
         
         Str1 = "数据9"
         Str2 = Sheets(数据表名).Cells(i, 15)
         .Selection.HomeKey Unit:=wdStory '光标置于文件首
         If .Selection.Find.Execute(Str1) Then '查找到指定字符串
            .Selection.Text = Str2 '替换字符串
            .Selection.Font.Color = wdColorAutomatic '字符为自动颜色
         End If
         
         Str1 = "数据10"
         Str2 = Sheets(数据表名).Cells(i, 13)
         .Selection.HomeKey Unit:=wdStory '光标置于文件首
         If .Selection.Find.Execute(Str1) Then '查找到指定字符串
            .Selection.Text = Str2 '替换字符串
            .Selection.Font.Color = wdColorAutomatic '字符为自动颜色
         End If
         
         
         

        '填写表格数据
'        .ActiveDocument.Tables(1).Cell(5, 2).Range = Sheets(数据表名).Cells(i, 3)
'        .ActiveDocument.Tables(1).Cell(5, 4).Range = Sheets(数据表名).Cells(i, 4)
'        .ActiveDocument.Tables(1).Cell(5, 7).Range = Sheets(数据表名).Cells(i, 5)
'        .ActiveDocument.Tables(1).Cell(5, 7).Range = Sheets(数据表名).Cells(i, 5)
        
        
      End With
      Word对象.Documents.Save
      Word对象.Quit
      Set Word对象 = Nothing
   Next i
   If 判断 = 0 Then
      j = MsgBox("已输出到 Word 文件！", 0 + 48 + 256 + 0, "提示：")
   End If
End Sub