Finding a "Heading" Style in a Word Document - vba

Question

I have a Word macro that allows to put his/her cursor anywhere in a Word document and it finds and saves the Heading 1, Heading 2 and Heading 3 text that is above the text selected by the user in order capture the chapter, section and sub-section that is associated with any sentence in the document.
I am currently using the code below which moves up the document line-by-line until it finds a style that contains "Heading x". When I have completed this task I move down the number of lines that I moved up to get to Heading 1, which may be many pages.
As you can imagine this is awkward, takes a long time (sometimes 60+ seconds) and is visually disturbing.
The code below is that subroutine that identifies the heading.
Dim str_heading_txt, hdgn_STYLE As String
Dim SELECTION_PG_NO as Integer
hdng_STYLE = Selection.Style
Do Until Left(hdng_STYLE, 7) = "Heading"
LINESUP = LINESUP + 1
Selection.MoveUp Unit:=wdLine, COUNT:=1
Selection.HomeKey Unit:=wdLine
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
hdng_STYLE = Selection.Style
'reached first page without finding heading
SELECTION_PG_NO = Selection.Information(wdActiveEndPageNumber)
If SELECTION_PG_NO = 1 Then 'exit if on first page
a_stop = True
Exit Sub
End If
Loop
str_heading_txt = Selection.Sentences(1)
I tried another approach below in order to eliminate the scrolling and performance issues using the Range.Find command below.
I am having trouble getting the selection range to move to the text with the "Heading 1" style. The code selects the sentence at the initial selection, not the text with the "Heading 1" style.
Ideally the Find command would take me to any style that contained "Heading" but, if required, I can code separately for "Heading 1", "Heading 2" and "Heading 3".
What changes to the code are required so that "Heading 1" is selected or, alternatively, that "Heading" is selected?
Dim str_heading_txt, hdgn_STYLE As String
Dim Rng As Range
Dim Fnd As Boolean
Set Rng = Selection.Range
With Rng.Find
.ClearFormatting
.Style = "Heading 1"
.Forward = False
.Execute
Fnd = .Found
End With
If Fnd = True Then
With Rng
hdng_STYLE = Selection.Style
str_heading_txt = Selection.Sentences(1)
End With
End If
Any assistance is sincerely appreciated.

Answer 1

You can use the range.GoTo() method.
Dim rngHead As Range, str_heading_txt As String, hdgn_STYLE As String
Set rngHead = Selection.GoTo(wdGoToHeading, wdGoToPrevious)
'Grab the entire text - headers are considered a paragraph
rngHead.Expand wdParagraph
' Read the text of your heading
str_heading_txt = rngHead.Text
' Read the style (name) of your heading
hdgn_STYLE = rngHead.Style
I noticed that you used Selection.Sentences(1) to grab the text, but headings are already essentially a paragraph by itself - so you can just use the range.Expand() method and expand using wdParagraph
Also, a bit of advice:
When declaring variables such as:
Dim str_heading_txt, hdgn_STYLE As String
Your intent was good, but str_heading_txt was actually declared as type Variant. Unfortunately with VBA, if you want your variables to have a specific data type, you much declare so individually:
Dim str_heading_txt As String, hdgn_STYLE As String
Or some data types even have "Shorthand" methods known as Type Characters:
Dim str_heading_txt$, hdgn_STYLE$
Notice how the $ was appended to the end of your variable? This just declared it as a String without requiring the As String.
Some Common Type-Characters:
$ String
& Long
% Integer
! Single
# Double
You can even append these to the actual value:
Dim a
a = 5
Debug.Print TypeName(a) 'Prints Integer (default)
a = 5!
Debug.Print TypeName(a) 'Prints Single

Answer 2

Try something based on:
Sub Demo()
Dim Rng As Range, StrHd As String, s As Long
s = 10
With Selection
Set Rng = .Range
Set Rng = Rng.GoTo(What:=wdGoToBookmark, Name:="\HeadingLevel")
StrHd = Rng.Paragraphs.First.Range.Text
Do While Right(Rng.Paragraphs.First.Style, 1) > 1
Rng.End = Rng.Start - 1
Set Rng = Rng.GoTo(What:=wdGoToBookmark, Name:="\HeadingLevel")
With Rng.Paragraphs.First
If Right(.Style, 1) < s Then
s = Right(.Style, 1)
StrHd = .Range.Text & StrHd
End If
End With
Loop
MsgBox StrHd
End With
End Sub