word vba

人在旅途LIU

请问，word文档中，这是一个长文档，比如怎样根据标题1，把各个标题1下，各个表格和标题1内容都提取出来到excel中

taller

请上传示例Doc文档

红太阳的天

将Word文档中的标题和表格根据特定的标题级别提取到Excel中是一个相对复杂的过程，通常需要使用VBA宏来实现。以下是一个基本的VBA宏示例，用于提取文档中所有“标题1”样式的内容以及它们下面的表格，并将它们复制到Excel工作表中：

Sub ExtractHeadingsAndTablesToExcel()
    Dim oExcelApp As Object
    Dim oExcelWB As Object
    Dim oExcelWS As Object
    Dim i As Long, j As Long
    Dim headingText As String
    Dim table As Table
    Dim rng As Range
   
    ' 创建或设置Excel实例
    Set oExcelApp = CreateObject("Excel.Application")
    Set oExcelWB = oExcelApp.Workbooks.Add
    Set oExcelWS = oExcelWB.Sheets(1)
   
    ' 在Excel中设置标题行
    oExcelWS.Cells(1, 1).Value = "标题1"
    oExcelWS.Cells(1, 2).Value = "表格"
   
    ' 遍历Word文档中的所有标题1
    i = 2 ' Excel中的起始行号
    For Each rng In ActiveDocument.Paragraphs
        If rng.Style = wdStyleHeading1 Then ' wdStyleHeading1 常量代表标题1样式
            ' 提取标题1文本
            headingText = rng.Text
            ' 将标题1复制到Excel的第一列
            oExcelWS.Cells(i, 1).Value = headingText
            
            ' 遍历标题1下的表格
            j = 0 ' 用于记录当前标题下的表格数量
            For Each table In rng.Tables
                j = j + 1 ' 表格数量加1
                ' 将表格复制到Excel的第二列
                ' 需要根据实际情况调整目标起始单元格位置
                oExcelWS.Cells(i + j, 2).Value = "Table " & j
                ' 复制表格内容到Excel，可能需要调整以适应不同大小的表格
                table.Range.Copy
                oExcelWS.Cells(i + j, 2).PasteSpecial Paste:=xlPasteAll
                Application.CutCopyMode = False ' 取消剪切板选中
            Next table
            
            ' 移动到下一个标题的行号
            i = i + j + 1
        End If
    Next rng
   
    ' 调整Excel窗口并激活
    oExcelApp.Visible = True
    oExcelWB.Activate
   
    ' 清理
    Set oExcelWS = Nothing
    Set oExcelWB = Nothing
    Set oExcelApp = Nothing
End Sub