用VBA写代码批量提取指定的Excel表格数据到Word的指定位置

以下是一个示例代码，可以实现批量提取指定的Excel表格数据到Word的指定位置。

前提条件：

- 需要将Excel表格和Word文档保存在同一文件夹下。
- Excel表格中需要提取的数据需要放在第一个工作表中。
- Word文档中需要插入表格的位置需要用“[Table]”表示，如“这里是[Table]”。

代码：

Sub ExtractDataToWord()
'定义变量
Dim ExcelApp As Object
Dim ExcelWorkbook As Object
Dim WordApp As Object
Dim WordDocument As Object
Dim ExcelSheet As Object
Dim WordRange As Object
Dim TableStart As Long
Dim TableEnd As Long
Dim TableNum As Long
Dim i As Long

'打开Excel应用程序和工作簿
Set ExcelApp = CreateObject("Excel.Application")
Set ExcelWorkbook = ExcelApp.Workbooks.Open(ThisWorkbook.Path & "\Data.xlsx")

'打开Word应用程序和文档
Set WordApp = CreateObject("Word.Application")
Set WordDocument = WordApp.Documents.Open(ThisWorkbook.Path & "\Report.docx")

'获取Word文档中所有的表格位置
TableNum = WordDocument.Tables.Count

'循环遍历所有的表格位置
For i = 1 To TableNum
'获取表格位置的起始和结束位置
TableStart = InStr(1, WordDocument.Tables(i).Range.Text, "[Table]")
TableEnd = InStr(TableStart + 1, WordDocument.Tables(i).Range.Text, "[Table]")

'如果找到了表格位置，则提取Excel表格数据并插入到Word文档中
If TableStart > 0 And TableEnd > 0 Then
'获取Excel表格数据
Set ExcelSheet = ExcelWorkbook.Sheets(1)
ExcelSheet.Range("A1:G10").Copy

'将表格数据粘贴到Word文档中
Set WordRange = WordDocument.Tables(i).Range
WordRange.Collapse Direction:=wdCollapseStart
WordRange.PasteExcelTable False, False, False
End If
Next i

'关闭Excel和Word对象
ExcelWorkbook.Close False
ExcelApp.Quit
WordDocument.Save
WordDocument.Close
WordApp.Quit

'释放对象
Set ExcelSheet = Nothing
Set ExcelWorkbook = Nothing
Set ExcelApp = Nothing
Set WordRange = Nothing
Set WordDocument = Nothing
Set WordApp = Nothing
End Sub