VBA：從selection.find使用文本從陣列

Question

返回頁面數（注：對於解決方案見下文）。

我一直在試圖從不同的標題使用Word文檔中駐留在頁面檢索頁碼VBA。我當前的代碼返回2或3，而不是正確關聯的頁碼，這取決於我在主Sub中使用它的位置和方式。

astrHeadings = docSource.GetCrossReferenceItems(wdRefTypeHeading) 

For Each hds In astrHeadings 
     docSource.Activate 
     With Selection.Find 
      .Text = Trim$(hds) 
      .Forward = True 
      MsgBox hds & ":" & Selection.Information(wdActiveEndPageNumber), vbOKOnly 
     End With 
     Selection.Find.Execute 
Next 

docSource是一個測試文檔，我用10個標題設置了3頁以上。我在後面的代碼中使用getCrossReferenceItems方法檢索到的標題。

我在嘗試的是循環遍歷getCrossReferenceItems方法的結果，並在docSource的查找對象中使用它們中的每一個，並從中確定結果在哪個頁面上。稍後在我的代碼中，頁碼將用於字符串中。這個字符串加上頁碼將被添加到在我的主子開頭創建的另一個文檔中，其他所有工作都可以處理，但是這個代碼段。

理想情況下，我需要該分段做的是用每個查找結果中的關聯頁碼填充第二個數組。

問題解決

感謝凱文，你已經有很大的幫助，在這裏，我現在正是我從這個Sub的輸出需要。

docSource是一個測試文檔，我用10個標題設置了3頁以上。 docOutline是一個新的文件，將作爲目錄文件。

我不得不使用這個Sub在Word的內置TOC功能，因爲：

1. 我有多個文件，包括，我可以使用RD領域包括這些，但

2. 我有另一個Sub，它在每個文檔0.0.0（chapter.section.page代表）中生成自定義小數頁編號，對於整個文檔包有意義，需要將其作爲頁碼包含在TOC中。這可能是另一種方式，但我用Word的內置功能留下了空白。

這將成爲包含在我的頁面編號Sub中的函數。我目前是完成這個小項目的3/4，最後一個季度應該是直截了當的。

修訂和清理的最終代碼

Public Sub CreateOutline() 
' from http://stackoverflow.com/questions/274814/getting-the-headings-from-a-word-document 
    Dim docOutline As Word.Document 
    Dim docSource As Word.Document 
    Dim rng As Word.Range 
    Dim strFootNum() As Integer 
    Dim astrHeadings As Variant 
    Dim strText As String 
    Dim intLevel As Integer 
    Dim intItem As Integer 
    Dim minLevel As Integer 
    Dim tabStops As Variant 

    Set docSource = ActiveDocument 
    Set docOutline = Documents.Add 

    minLevel = 5 'levels above this value won't be copied. 

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

    docSource.Select 
    ReDim strFootNum(0 To UBound(astrHeadings)) 
    For i = 1 To UBound(astrHeadings) 
     With Selection.Find 
      .Text = Trim(astrHeadings(i)) 
      .Wrap = wdFindContinue 
     End With 

     If Selection.Find.Execute = True Then 
      strFootNum(i) = Selection.Information(wdActiveEndPageNumber) 
     Else 
      MsgBox "No selection found", vbOKOnly 
     End If 
     Selection.Move 
    Next 

    docOutline.Select 

    With Selection.Paragraphs.tabStops 
     '.Add Position:=InchesToPoints(2), Alignment:=wdAlignTabLeft 
     .Add Position:=InchesToPoints(6), Alignment:=wdAlignTabRight, Leader:=wdTabLeaderDots 
    End With 

    For intItem = LBound(astrHeadings) To UBound(astrHeadings) 
     ' Get the text and the level. 
     ' strText = Trim$(astrHeadings(intItem)) 
     intLevel = GetLevel(CStr(astrHeadings(intItem))) 
     ' Test which heading is selected and indent accordingly 
     If intLevel <= minLevel Then 
       If intLevel = "1" Then 
        strText = " " & Trim$(astrHeadings(intItem)) & vbTab & "1" & "." & "2" & "." & strFootNum(intItem) & vbCr 
       End If 
       If intLevel = "2" Then 
        strText = " " & Trim$(astrHeadings(intItem)) & vbTab & "1" & "." & "2" & "." & strFootNum(intItem) & vbCr 
       End If 
       If intLevel = "3" Then 
        strText = "  " & Trim$(astrHeadings(intItem)) & vbTab & "1" & "." & "2" & "." & strFootNum(intItem) & vbCr 
       End If 
       If intLevel = "4" Then 
        strText = "   " & Trim$(astrHeadings(intItem)) & vbTab & "1" & "." & "2" & "." & strFootNum(intItem) & vbCr 
       End If 
       If intLevel = "5" Then 
        strText = "   " & Trim$(astrHeadings(intItem)) & vbTab & "1" & "." & "2" & "." & strFootNum(intItem) & vbCr 
       End If 
      ' Add the text to the document. 
      rng.InsertAfter strText & vbLf 
      docOutline.SelectAllEditableRanges 
      ' tab stop to set at 15.24 cm 
      'With Selection.Paragraphs.tabStops 
      ' .Add Position:=InchesToPoints(6), _ 
      ' Leader:=wdTabLeaderDots, Alignment:=wdAlignTabRight 
      ' .Add Position:=InchesToPoints(2), Alignment:=wdAlignTabCenter 
      'End With 
      rng.Collapse wdCollapseEnd 
     End If 
    Next intItem 
End Sub 

Private Function GetLevel(strItem As String) As Integer 
    ' from http://stackoverflow.com/questions/274814/getting-the-headings-from-a-word-document 
    ' 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 

現在這個代碼是生產（它應該根據測試doc.docx發現我的標題規範中）：

This is heading one     1.2.1 
    This is heading two    1.2.1 
    This is heading two.one   1.2.1 
    This is heading two.three  1.2.1 
This is heading one.two    1.2.2 
    This is heading three   1.2.2 
     This is heading four   1.2.2 
      This is heading five  1.2.2 
      This is heading five.one 1.2.3 
      This is heading five.two 1.2.3 

在除此之外，我通過使用docSource.select和docOutline.Select聲明而不是使用.Active來解決ActiveDocument切換問題。

再次感謝凱文，不勝感激:-)

菲爾

Answer 1

看起來Selection.Information(wdActiveEndPageNumber)將適合該法案，雖然它在錯誤的點代碼的當前。把這一行在執行查找後，像這樣：

For Each hds In astrHeadings 
    docSource.Activate 
    With Selection.Find 
     .Text = Trim$(hds) 
     .Forward = True 
    End With 
    Selection.Find.Execute 
    MsgBox hds & ":" & Selection.Information(wdActiveEndPageNumber), vbOKOnly 
Next 

加入新的問題：

當你設置strFooter值，你用你ReDim時，調整陣列應該使用ReDim Preserve：

ReDim Preserve strFootNum(1 To UBound(astrHeadings)) 

但是，除非UBound(astrHeadings)有問題的For循環過程中不斷變化的，它很可能是最好的做法，以拉動ReDim語句循環之外：

ReDim strFootNum(0 To UBound(astrHeadings)) 
For i = 0 To UBound(astrHeadings) 
    With Selection.Find 
     .Text = Trim(astrHeadings(i)) 
     .Wrap = wdFindContinue 
    End With 

    If Selection.Find.Execute = True Then 
     strFootNum(i) = Selection.Information(wdActiveEndPageNumber) 
    Else 
     strFootNum(i) = 0 'Or whatever you want to do if it's not found' 
    End If 
    Selection.Move 
Next 

作爲參考，ReDim語句設置在陣列中的所有項目返回到0，而ReDim Preserve保留在陣列中的所有數據，你調整它。

還請注意Selection.Move和.Wrap = wdFindContinue行 - 我認爲這些是我以前的建議的問題的根源。選擇將被設置爲最終頁面，因爲查找不會在第一次運行以外的任何運行中進行包裝。