Vba 将Word表格标题复制并粘贴到Excel中

我有一个包含多个表的word文档。我在excel中有一些脚本，它在word文档中循环，提取word中的所有表格，并将其导入excel。该脚本允许用户选择从哪个表开始（仅供参考）。我试图做的是让脚本将该表的标题带过来（粗体和下划线），并将其附加到相邻的列中。并将该列标题命名为“章节标题”。有些标题在标题后面有单词，然后是表格本身。然后有些人就有了标题，紧接着就是表格。我需要的是粗体下划线的标题

以下是word文档的外观：

以下是我所需要的：

以下是我目前的情况：

Option Explicit

Sub Macro1()

Dim wdDoc As Object
Dim wdFileName As Variant
Dim tableNo As Integer 'table number in Word
Dim resultRow As Long
Dim tableStart As Integer
Dim tableTot As Integer
Dim wdApp As Object, wdTable As Object
Dim iRow As Long, iCol As Long
Dim thisText As String, newText As String



On Error Resume Next

ActiveSheet.Range("A:AZ").ClearContents

wdFileName = Application.GetOpenFilename("Word files (*.docx),*.docx", , _
"Browse for file containing table(s) to be imported")

If wdFileName = False Then Exit Sub '(user cancelled import file browser)

Set wdDoc = GetObject(wdFileName) 'open Word file

With wdDoc
    tableNo = wdDoc.Tables.Count
    tableTot = wdDoc.Tables.Count
    If tableNo = 0 Then
        MsgBox "This document contains no tables", _
        vbExclamation, "Import Word Table"
    ElseIf tableNo > 1 Then
        tableNo = InputBox("This Word document contains " & tableNo & " tables." & vbCrLf & _
        "Enter the table to start from", "Import Word Table", "1")  'Enter table number to start at
    End If


    resultRow = 1

For tableStart = 1 To tableTot
With .Tables(tableStart)
    For iRow = 1 To .Rows.Count
        For iCol = 1 To .Columns.Count
            thisText = .Cell(iRow, iCol).Range.Text
            newText = Replace(thisText, Chr(13), vbCrLf)
            newText = Replace(newText, Chr(7), vbNullString)
            Cells(resultRow, iCol) = newText
        Next iCol
        resultRow = resultRow + 1
    Next iRow
    End With
    resultRow = resultRow + 1
Next tableStart
End With

End Sub

最重要的答案可能是一个好的开始

根据您提供的内容，您可以搜索粗体和下划线文本，并通过循环或首选项将所选内容输入excel

以下是链接中的代码（以节省时间），其中包含一些用于使用excel的编辑：

Sub SearchTitles()

    Dim wordDoc As Document
    Dim rng As Range
    Dim lastRow As Long
    Dim row As Integer

    Set wordDoc = Documents("your document filename")  ' open the doc prior to running
    Set rng = wordDoc.Range(0, 0)    

    With ThisWorkbook.Worksheets("your sheet name")
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).row
    End With

    For row = 1 To lastRow
        With rng.Find
            .ClearFormatting
            .Format = True
            .Font.Bold = True
            .Font.Underline = True
            While .Execute
                rng.Select
                rng.Collapse direction:=wdCollapseEnd

                ' Do something here with selection
               ThisWorkbook.Worksheets("your sheet name").Range("E" & row).Value = Selection

            Wend
        End With
        Set rng = Selection.Range
    Next   

End Sub

---

这个解决方案非常简单，因为它假设文档中没有其他粗体和下划线文本，但希望它是一个开始。。。祝你好运

虽然你提供了很多细节，但你没有提供解决你所面临问题的方法。本代码中没有任何试图提取您引用的标题的内容。因此，您实际上是要求我们为您编写代码，这超出了So的范围。也就是说，我最近在自己的工作中考虑过类似的事情，我唯一能做的就是循环阅读文本并比较字符字体。在您的例子中，从表格区域的开始向后循环，查找粗体和下划线文本，并从末尾捕获文本以开始获取标题。