Ndtyjky

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.

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

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