2

次の VBA 問題:

複数の章 (「見出し 1」) を含む Word 文書があります。各章の最初に、処理したい情報が記載された表が続きます。ドキュメントの「テーブル」コレクションをループして、テーブル内の情報を抽出するのは簡単です。

しかし、論文の表がどの下にあるかという情報、別名「章名」(「見出し 1」) を取得するにはどうすればよいでしょうか?

「テーブル」コレクション内のテーブルから周囲のチャプター名 (「見出し 1」) への「リンク」を見つける方法が必要です。そこで、コレクション内の「表」-オブジェクトの情報を使用して、章名 (「見出し 1」) を見つけます (doc.Tables(1) --> 「3. Chaptertitle 3rd chapter」)。

私の考えは、スタイル「見出し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

すべての見出しフォーム ドキュメントを取得する方法は知っていますが、表の章を見つける方法がわかりません。

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

アイデアをありがとう

4

1 に答える 1

2

Selection.goToNext wdGoToHeading Selection.goToNext wdGoToTable を使用してドキュメントに移動できます。

そうすれば、どの表がどの見出しの後にあるかを思い出すことができます。より詳細なコード サンプルが必要な場合は、お問い合わせください。提供します。

于 2014-07-06T01:37:36.097 に答える