请求提供Word嵌套表格复制到Excel的示例及特定行列复制方案

一、遍历并复制所有嵌套表格到Excel #

以下VBA代码可递归遍历Word文档中的所有表格（包括嵌套在单元格内的子表格），并依次粘贴到Excel工作表中：

Sub CopyAllNestedTablesToExcel()
    Dim wordApp As Object
    Dim wordDoc As Object
    Dim excelApp As Object
    Dim excelSheet As Object
    Dim mainTable As Object
    Dim targetRow As Long
    
    ' 初始化Excel应用
    Set excelApp = CreateObject("Excel.Application")
    excelApp.Visible = True
    Set excelSheet = excelApp.Workbooks.Add.Worksheets(1)
    targetRow = 1
    
    ' 绑定当前激活的Word文档
    Set wordApp = GetObject(, "Word.Application")
    Set wordDoc = wordApp.ActiveDocument
    
    ' 遍历文档中所有顶层表格
    For Each mainTable In wordDoc.Tables
        ' 复制当前表格及嵌套子表格
        CopyTableAndNested mainTable, excelSheet, targetRow
    Next mainTable
    
    Set wordDoc = Nothing
    Set wordApp = Nothing
    Set excelSheet = Nothing
    Set excelApp = Nothing
End Sub

' 递归复制表格及嵌套子表格的辅助函数
Private Sub CopyTableAndNested(sourceTable As Object, targetSheet As Object, ByRef startRow As Long)
    Dim cell As Object
    Dim nestedTable As Object
    
    ' 复制当前表格到Excel
    sourceTable.Range.Copy
    targetSheet.Cells(startRow, 1).PasteSpecial Paste:=xlPasteAll
    
    ' 更新下一个表格的起始行（留空行分隔不同表格）
    startRow = startRow + sourceTable.Rows.Count + 2
    
    ' 遍历当前表格的所有单元格，检查是否有嵌套表格
    For Each cell In sourceTable.Range.Cells
        If cell.Tables.Count > 0 Then
            For Each nestedTable In cell.Tables
                ' 递归处理嵌套表格
                CopyTableAndNested nestedTable, targetSheet, startRow
            Next nestedTable
        End If
    Next cell
End Sub

代码说明：

• 递归函数CopyTableAndNested会遍历每个表格的单元格，发现嵌套表格就继续递归处理
• 复制时会在不同表格之间留2行空行，方便区分
• 自动创建新的Excel工作簿并显示，可修改代码绑定已有的Excel文件

二、提取特定行列的所有表格并复制到Excel #

如果需要只提取位于Word文档中特定行列位置的表格（比如所有在第2行第3列单元格内的表格），可以用以下代码：

Sub CopySpecificRowColTablesToExcel()
    Dim wordApp As Object
    Dim wordDoc As Object
    Dim excelApp As Object
    Dim excelSheet As Object
    Dim mainTable As Object
    Dim targetRow As Long
    Dim targetWordRow As Integer ' 目标行号（Word表格中的行）
    Dim targetWordCol As Integer ' 目标列号（Word表格中的列）
    
    ' 设置要提取的目标行列（示例：第2行第3列）
    targetWordRow = 2
    targetWordCol = 3
    
    ' 初始化Excel应用
    Set excelApp = CreateObject("Excel.Application")
    excelApp.Visible = True
    Set excelSheet = excelApp.Workbooks.Add.Worksheets(1)
    targetRow = 1
    
    ' 绑定当前激活的Word文档
    Set wordApp = GetObject(, "Word.Application")
    Set wordDoc = wordApp.ActiveDocument
    
    ' 遍历所有顶层表格
    For Each mainTable In wordDoc.Tables
        ' 检查当前表格是否有足够的行列
        If mainTable.Rows.Count >= targetWordRow And mainTable.Columns.Count >= targetWordCol Then
            ' 检查目标单元格是否包含表格
            If mainTable.Cell(targetWordRow, targetWordCol).Tables.Count > 0 Then
                Dim nestedTable As Object
                For Each nestedTable In mainTable.Cell(targetWordRow, targetWordCol).Tables
                    ' 复制表格到Excel
                    nestedTable.Range.Copy
                    excelSheet.Cells(targetRow, 1).PasteSpecial Paste:=xlPasteAll
                    targetRow = targetRow + nestedTable.Rows.Count + 2
                Next nestedTable
            End If
        End If
        ' 递归检查当前表格的嵌套表格中是否有符合条件的
        CheckNestedTablesForTarget mainTable, targetWordRow, targetWordCol, excelSheet, targetRow
    Next mainTable
    
    Set wordDoc = Nothing
    Set wordApp = Nothing
    Set excelSheet = Nothing
    Set excelApp = Nothing
End Sub

' 递归检查嵌套表格中是否存在目标行列表格的辅助函数
Private Sub CheckNestedTablesForTarget(sourceTable As Object, targetRow As Integer, targetCol As Integer, targetSheet As Object, ByRef startRow As Long)
    Dim cell As Object
    Dim nestedTable As Object
    
    For Each cell In sourceTable.Range.Cells
        If cell.Tables.Count > 0 Then
            For Each nestedTable In cell.Tables
                ' 检查当前嵌套表格是否符合目标行列条件
                If nestedTable.Rows.Count >= targetRow And nestedTable.Columns.Count >= targetCol Then
                    If nestedTable.Cell(targetRow, targetCol).Tables.Count > 0 Then
                        Dim innerNestedTable As Object
                        For Each innerNestedTable In nestedTable.Cell(targetRow, targetCol).Tables
                            innerNestedTable.Range.Copy
                            targetSheet.Cells(startRow, 1).PasteSpecial Paste:=xlPasteAll
                            startRow = startRow + innerNestedTable.Rows.Count + 2
                        Next innerNestedTable
                    End If
                End If
                ' 继续递归检查更深层的嵌套表格
                CheckNestedTablesForTarget nestedTable, targetRow, targetCol, targetSheet, startRow
            Next nestedTable
        End If
    Next cell
End Sub

代码说明：

• 先设置targetWordRow和targetWordCol指定要提取的表格所在的行列位置
• 不仅检查顶层表格，还会递归检查所有嵌套表格中的目标位置
• 同样会在Excel中用空行分隔不同的表格

使用注意事项 #

• 运行代码前确保Word文档处于激活状态
• 如果需要粘贴特定格式（比如只粘贴值），可以修改PasteSpecial的参数，比如xlPasteValues
• 代码中使用后期绑定，无需提前引用Excel/Word对象库，兼容性更好

内容的提问来源于stack exchange，提问作者sashidhar sashi