Last active
December 29, 2023 05:24
-
-
Save wsxq2/850b398c8c6f21d58ed363e84a5931a6 to your computer and use it in GitHub Desktop.
将 Excel 中的 N 行数据导出到 Word 中的 N 个表格中
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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 |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment