Question

以下VBA问题：

我有一个包含几个章节的Word文档（“标题1”）。在章节的开头，有一个表格，其中包含我想要处理的信息。可以轻松地循环遍历文档的“Tables”集合，以提取表格中的信息。

但是如何才能获得这些表格所在的“章节名称”（“标题1”）的信息呢？

我需要一种方法从“Tables”中的表中找到“链接” - 收集到周围的章节名称（“标题1”）。因此，使用集合中的“表格”-Objekt的信息（doc.Tables（1） - ＆gt;“3. Chaptertitle 3rd chapter”）找到章节名称（“标题1”）。

我的想法是从桌子的位置向后搜索，直到找到样式为“标题1”的范围。但是我如何获得位置信息呢？

    Public Sub ImportRequirementsFromWordTables()

    Dim wdDoc As Object
    Dim wdFileName As Variant
    Dim TableNo As Integer 'table number in Word
    Dim iRowWord As Long 'row index in Word
    Dim iRowExcel As Long
    Dim iColWord As Integer 'column index in Excel
    Dim tbl As Variant
    Dim strCurrCell As String


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

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

    Set wdDoc = GetObject(wdFileName) 'open Word file

    'Set Titles in Excel
    Cells(1, 1) = "Anf.-ID"
    Cells(1, 2) = "Referenz"
    Cells(1, 3) = "Anforderungstitel"
    Cells(1, 4) = "System"
    Cells(1, 5) = "Art"
    Cells(1, 6) = "Priorität"
    Cells(1, 7) = "Beschreibung (optional)"


    With wdDoc
        TableNo = wdDoc.Tables.Count
        For Each tbl In wdDoc.Tables
            'Check if it is a table with Reqs
            If Left$(tbl.Cell(1, 1).Range.Text, 7) = "Anf.-ID" Then
                'copy cell contents from Word table cells to Excel cells
                With tbl
                    'Find Chapter Name of chapter table lies in in Word and write to Excel
                    '????

                    iRowWord = 2
                    iRowExcel = 2
                    While iRowWord < .Rows.Count
                        For iColWord = 1 To .Columns.Count
                            strCurrCell = .Cell(iRowWord, iColWord).Range.Text
                            Cells(iRowExcel, iColWord) = Mid$(strCurrCell, 1, Len(strCurrCell) - 1)
                        Next iColWord

                        'Fill Description
                        strCurrCell = strReplaceSpecialCharacters(.Cell(iRowWord + 1, 3).Range.Text)
                        Cells(iRowExcel, 7) = Mid$(strCurrCell, 1, Len(strCurrCell) - 1)

                        'Skip to next relevant in Word aka skip one 
                        iRowWord = iRowWord + 2
                        'Skip to next in Excel
                        iRowExcel = iRowExcel + 1
                    Wend
                End With
            End If
        Next
    End With

    Set wdDoc = Nothing

End Sub

我知道如何获取所有Heaadings表单文档，但我想念如何查找表格的章节：

Private Sub getHeading(wdSource As Document)

        Dim docSource As Word.Document
        Dim rng As Word.Range

        Dim astrHeadings As Variant
        Dim strText As String
        Dim intLevel As Integer
        Dim intItem As Integer

        Set docSource = wdSource

        ' Content returns only the
        ' main body of the document, not
        ' the headers and footer.
        astrHeadings = _
         docSource.GetCrossReferenceItems(wdRefTypeHeading)

        For intItem = LBound(astrHeadings) To UBound(astrHeadings)
            ' Get the text and the level.
            strText = Trim$(astrHeadings(intItem))
            intLevel = GetLevel(CStr(astrHeadings(intItem)))

            Debug.Print intLevel & " " & strText

        Next intItem
    End Sub
    Private Function GetLevel(strItem As String) As Integer
        ' Return the heading level of a header from the
        ' array returned by Word.

        ' The number of leading spaces indicates the
        ' outline level (2 spaces per level: H1 has
        ' 0 spaces, H2 has 2 spaces, H3 has 4 spaces.

        Dim strTemp As String
        Dim strOriginal As String
        Dim intDiff As Integer

        ' Get rid of all trailing spaces.
        strOriginal = RTrim$(strItem)

        ' Trim leading spaces, and then compare with
        ' the original.
        strTemp = LTrim$(strOriginal)

        ' Subtract to find the number of
        ' leading spaces in the original string.
        intDiff = Len(strOriginal) - Len(strTemp)
        GetLevel = (intDiff / 2) + 1
    End Function

感谢您的任何想法

Answer 1

您可以通过文档使用 Selection.goToNext wdGoToHeading Selection.goToNext wdGoToTable

通过这种方式，您可以重新标记哪个表位于哪个标题之后。如果您需要更详细的代码示例，请询问，我会为您提供。

在MS Word中找到表格在文档中的标题

1 个答案: