假如一个公司的员工信息被存储在 Excel 中，需要将这些信息按照表格的形式呈现在公司的Word报告中，使用此代码可以快速方便地实现这个任务。
案例：Word用VBA提取Excel文件名为“员工资料”文件中的工作表名为sheet1的所有数据，并在Word中以表格形式显示。
如下面的图片所示：
一、Word导入效果：
Word导入效果
二、EXCEL源表格：
EXCEL源表格
实现代码：Sub ExtractDataFromExcelAndCreateTableInWord()
' 声明变量
Dim ExcelFilePath As String
Dim ExcelApp As Object
Dim ExcelWorkbook As Object
Dim ExcelWorksheet As Object
Dim WordApp As Object
Dim WordDoc As Object
Dim WordTable As Object
Dim LastRow As Long
Dim LastColumn As Long
Dim i As Long
Dim j As Long
' 设置 Excel 文件路径
ExcelFilePath = "d:\员工资料.xlsx"
' 创建 Excel 应用程序对象并打开工作簿
On Error Resume Next ' 开始错误处理程序
Set ExcelApp = CreateObject("Excel.Application")
Set ExcelWorkbook = ExcelApp.Workbooks.Open(ExcelFilePath)
On Error GoTo 0 ' 关闭错误处理程序
' 检查文件是否成功打开
If ExcelWorkbook Is Nothing Then
MsgBox "无法打开 Excel 文件，请检查文件路径是否正确或文件是否被其他程序或用户占用。", vbCritical, "错误"
Exit Sub
End If
' 获取名为 "Sheet1" 的工作表
Set ExcelWorksheet = ExcelWorkbook.Worksheets("Sheet1")
' 获取数据行数和列数
LastRow = ExcelWorksheet.Cells(ExcelWorksheet.Rows.Count, 1).End(-4162).Row ' -4162 表示 xlUp
LastColumn = ExcelWorksheet.Cells(1, ExcelWorksheet.Columns.Count).End(-4159).Column ' -4159 表示 xlToLeft
' 创建 Word 应用程序对象并新建文档
Set WordApp = CreateObject("Word.Application")
Set WordDoc = WordApp.Documents.Add()
' 在 Word 文档中创建表格
Set WordTable = WordDoc.Tables.Add(WordDoc.Range, LastRow, LastColumn)
' 将 Excel 数据复制到 Word 表格中
For i = 1 To LastRow
For j = 1 To LastColumn
WordTable.Cell(i, j).Range.Text = ExcelWorksheet.Cells(i, j).Value
Next j
Next i
' 设置表格样式
With WordTable
' 设置边框样式
.Borders.InsideLineStyle = wdLineStyleSingle
.Borders.OutsideLineStyle = wdLineStyleSingle
' 设置表格自动调整宽度和列宽度自动调整
.AutoFitBehavior (wdAutoFitWindow)
.AllowAutoFit = True
' 设置表格字体和大小
.Range.Font.Name = "宋体"
.Range.Font.Size = 10
' 设置表头样式
.Rows(1).Shading.BackgroundPatternColor = wdColorGray15
.Rows(1).Range.Font.Bold = True
.Rows(1).Range.Font.Color = wdColorBlack
' 设置表格内容自动居中
.Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
End With
' 显示 Word 应用程序和文档
WordApp.Visible = True
WordDoc.Activate
' 关闭 Excel 应用程序和工作簿
ExcelWorkbook.Close
ExcelApp.Quit
End Sub
需要注意的是，在使用此代码之前，需要确保已安装了 Microsoft Excel 和 Microsoft Word，并且在代码中指定的 Excel 文件路径和工作表名称是正确的。
