实例需求：Excel中产品表如下图所示。
现需要根据Excel产品表创建如下所示的Word表格（标签），虚线框中格式说明（字体大小），代码输出Word文档，无需此部分。
vb
Sub Excel2Word()
Dim ws As Worksheet, wdDoc As Object, wdApp As Object
Dim i As Long, j As Long
On Error Resume Next
Set wdApp = GetObject(, "Word.Application")
On Error GoTo 0
If wdApp Is Nothing Then
On Error Resume Next
Set wdApp = CreateObject("Word.Application")
On Error GoTo 0
End If
If wdApp Is Nothing Then
MsgBox "Microsoft Word is not installed or accessible.", vbExclamation
Exit Sub
End If
wdApp.Visible = True
Set ws = ThisWorkbook.Worksheets("Sheet1")
Dim oTab As ListObject
If ws.ListObjects.Count = 0 Then
Set oTab = ws.ListObjects.Add(xlSrcRange, ws.Range("A1").CurrentRegion, , xlYes)
Else
Set oTab = ws.ListObjects(1)
End If
Dim RowCnt As Long: RowCnt = oTab.ListRows.Count * 3 + 1
Set wdDoc = wdApp.Documents.Add
Dim wdTab As Object
Set wdTab = wdDoc.Tables.Add(Range:=wdDoc.Range, NumRows:=RowCnt, _
NumColumns:=1, DefaultTableBehavior:=1, AutoFitBehavior:=0)
With wdTab.Range
.ParagraphFormat.Alignment = 1
.Font.Bold = True
.Font.Size = 11
End With
For i = 3 To RowCnt Step 3
wdTab.cell(i, 1).Split 1, 3
wdTab.Rows(i).Borders(-6).LineStyle = 0
Next
wdTab.cell(RowCnt, 1).Split 1, 3
wdTab.Rows(RowCnt).Borders(-6).LineStyle = 0
Dim arr: arr = oTab.DataBodyRange.Value
For i = 1 To oTab.ListRows.Count
With wdTab.cell(i * 3 - 2, 1).Range
.Text = arr(i, 1)
.Font.Size = 16
End With
With wdTab.cell(i * 3 - 1, 1).Range
.Text = arr(i, 2)
.Font.Size = 12
End With
For j = 1 To 3
wdTab.cell(i * 3, j).Range.Text = arr(i, j + 2)
Next
Next
wdTab.cell(RowCnt, 1) = arr(1, 6)
wdTab.cell(RowCnt, 2) = arr(1, 7)
wdTab.cell(RowCnt, 3) = Format(Date, "mmmm dd, yyyy")
wdDoc.SaveAs ThisWorkbook.Path & "\WordTable.docx"
MsgBox "Task completed.", vbInformation
End Sub【代码解析】
第4行代码开启错误忽略模式。
第5行代码尝试获取已打开的 Word 应用实例。
第6行代码恢复正常错误处理。
第7行代码判断 wdApp 是否为空，如果为空则进入条件分支。
第8行代码再次开启错误忽略模式。
第9行代码尝试新建 Word 应用对象。
第10行代码恢复正常错误处理。
第12行代码再次判断 wdApp 是否为空。
第13行代码如果为空则弹出提示框，提示 Word 未安装或不可用。
第14行代码退出过程。
第15行代码结束第二次条件分支。
第16行代码设置 Word 应用可见，实际使用过程中，为了提升代码执行效率，可以隐藏 Word 应用。
第17行代码获取当前工作簿中名为 "Sheet1" 的工作表。
第19行代码判断工作表是否存在表格对象（ListObject，下同）。
如果没有表格对象，则第20行代码将数据区域转换为表格对象。
否则，第22行代码直接获取第一个表格对象。
第24行代码计算 Word 表格需要的总行数 RowCnt，每个数据行对应Word表格中的三行，额外加一行。
第25行代码在 Word 应用中新建一个文档。
第27-28行代码在 Word 文档中插入表格，行数为 RowCnt，列数为 1。
第29-33行代码通过 With 语句设置表格整体格式：段落居中、字体加粗、字号 11。
第34行代码启动循环，从第 3 行开始，每隔 3 行执行一次。
第35行代码将该行的单元格拆分为 3 列。
第36行代码移除该行的内部垂直边框线。
第38-39行代码对最后一行执行同样的拆分，并移除边框。
第40行代码将 Excel 表格主体数据读入数组 arr。
第41行代码启动循环，遍历 Excel 表格的每一行。
第42-45行代码将 Excel 第一列内容写入 Word 表格，设置字号 16。
第46-49行代码将 Excel 第二列内容写入 Word 表格，设置字号 12。
第50-52行代码将 Excel 第 3 至第 5 列数据写入 Word 表格的三列。
第53行代码结束循环。
第54行代码在 Word 表格最后一行第 1 列填入 Excel 第 6 列内容。
第55行代码在 Word 表格最后一行第 2 列填入 Excel 第 7 列内容。
第56行代码在 Word 表格最后一行第 3 列填入当前日期。
第57行代码将 Word 文档保存到当前工作簿路径，文件名为 WordTable.docx。
第55行代码弹出提示框，提示任务完成。