将 Excel 中的 N 行数据导出到 Word 中的 N 个表格中

auto_export_data_from_excel_to_word.vb

Sub auto_export_data_from_excel_to_word()
'将 Excel 中的 N 行数据导出到 Word 中的 N 个表格中
'输入：一个Excel表（提供数据），一个doc模板（提供表格模板）
'输出：一个doc文件，默认名称为 output.doc
'使用方法：
'    1. 打开Word和 Excel 的“开发工具”工具栏。可Bing搜索具体方法
'    2. 复制本函数代码到Excel文件的Visual Basic中：先打开Excel文件，点击“开发工具”，再点击“VisualBasic”，然后新建一个模块，将本函数代码复制过去
'    3. 调整本函数：一是调整doc输入输出文件名；二是Excel表格起始行和结束行，同时注意 wdapp.ActiveDocument.tables(r -1)的下标要正确调整；三是数据赋值部分需要正确对应相应的单元格；四是查找的内容要正确替换
'    4. 运行
  
'获取模板文件和输出文件路径
  f = ThisWorkbook.Path & "\input.doc"
  newf = ThisWorkbook.Path & "\output.doc"

  FileCopy f, newf 

  ' 声明变量
  Dim wdapp As Word.Application
  Dim WdDocument As Word.Document
  Dim rs, re As Word.Range
  Dim tbl,t2 As Word.Table
  
  '打开模板文件
  Set wdapp = New Word.Application
  Set WdDocment = wdapp.Docments.Open(newf)

  '设置Word文档程序可见
  wdapp.Visible = True

  If True Then

    '选择整个文档并复制，后续每加一个表粘贴一次
    WdDocument.Select
    wdapp.Selection.Copy
    
    '将光标移动到第一个标题处
    Set rs = wdapp.Selection.Goto(what:=wdGoToHeading, which:=wdGoToFirst)

    '循环读取 Excel 表格中的每一行
    For r = 2 To 37
      '将光标移动到文档末尾
      wdapp.Selection.EndkKey Unit:=wdStory
      '粘贴之前复制的内容
      wdapp.Selection.Paste
      '从表格中获取指定单元格中的内容
      no = Sheets(1).Cells(r,1).Value
      '...
      '从word中获取表对象引用，并对其指定单元格赋值
      Set tbl = wdapp.ActiveDocument.tables(r-1)
      tbl.Cell(2,2)=no
      '...
              
      '将光标移动到rs处
      rs.Select
      '跳转到下一个标题处
      Set re = wdapp.Selection.GoTo(what:=wdGoToHeading, which:=wdGoToNext)
      '选择上一个标题到这一个标题间的内容
      wdapp.ActiveDocument.Range(rs.Start, re.End).Select
      '显示r变量的值（可用于调试，知道当前执行到第几行了）
      'MsgBox r
      
      '对选中内容进行查找替换，替换默认的 XXX 为之前从表格中得到的no
      With wdapp.Selection.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Replacement.Text = no
        .Forward = True
        .MatchWildcards = True
        x=.Execute(findtext:="xxx", Replace:=wdReplaceAll)
      End With
      '迭代rs
      Set rs = re
      '迭代r
      Next r
    '删除最后一个标题及其内容，从而去掉多出的一个表格
    Set re=wdapp.Selection.GoTo(what:=wdGoToLine, which:=wdGoToLast)
    wdapp.ActiveDocument.Range(rs.Start, re.End).Delete

End If
'保存并关闭打开的文档
WdDocument.Save
WdDocument.Close

End Sub