在MS Word中找到的標題下了一個表格是

Question

如下因素VBA問題在文件中：

我有幾個章節Word文檔（「標題1」）。在章節的開頭部分，有一張表格，裏面有我想要處理的信息。 通過文檔的「表」集合很容易循環以提取表中的信息。

但是，如何獲得信息又名「章名」（「標題1」），這些表在哪裏呢？

我需要一種方法來從「表」中的表中找到「鏈接」 - 收集到周圍的章節名稱（「標題1」）。因此，使用集合中的「表格 - 對象」（doc.Tables（1） - >「3. Chaptertitle第3章」）的信息找到章節名稱（「標題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

你可以走通的文檔使用 選擇.goToNext wdGoToHeading Selection.goToNext wdGoToTable

這樣，你可以的rember該表之後標題。 如果你需要更詳細的代碼示例，請問，我會爲你提供。