Перечислите все экземпляры стиля "Заголовок 1"

Question

Я пытаюсь перечислить каждый экземпляр стиля "Заголовок 1" в моем документе (чтобы в конечном итоге перечислить их в поле со списком на форме).

Следующий код появляется для поиска экземпляров "Заголовок 1", так как в "Немедленном окне" указано правильное количество записей, но .text ничего не возвращает.

Что я делаю неправильно? Благодарю.

Dim blnFound As Boolean
Dim i as Integer

i = 1

With ThisDocument.Range.Find
    .Style = "Heading 1"

    Do
        blnFound = .Execute
        If blnFound Then
            Debug.Print i & " " & .Text
            i = i + 1
        Else
            Exit Do
        End If
    Loop
End With

Answer 1

Я не верю, что у вашего объекта есть свойство.Text. Выбор имеет свойство.Text. Попробуй это:

Sub FindHeadings()
' October 28, 2014
Dim blnFound As Boolean
Dim i As Integer
i = 1
' Set up the find conditions
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
Selection.Find.Style = ActiveDocument.Styles("Heading 1")
With Selection.Find
    .Text = ""
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.MoveLeft Unit:=wdCharacter, count:=1

'Repeat while you find the style
blnFound = True
While blnFound
    With Selection.Find
        .Execute
        If .Found = True Then
                Debug.Print i & " " & Selection.Text
                i = i + 1
            ' Move to the next character
            Selection.MoveRight Unit:=wdCharacter, count:=1
        Else
            Debug.Print "Done"
            blnFound = False
        End If
    End With
Wend
End Sub