Finding a “Heading” Style in a Word Document

1
votes

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.

2
vbams-word

2 Answers

1
votes

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
0
votes

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