CODEWITHSUNDEEP
vbams-word
East Coast Techwriter
East Coast Techwriter

Reputation: 29

Insert Text in MS Word Multilevel List Headings Using VBA

I requested help from the forum about 6 months ago but my issue remains only partly resolved. I'm hoping someone may help me recognize where my mistake is taking place in the code I have created.

My issue is that I want to use VBA to insert a very brief amount of standardized text before the English-language string in my multilevel list headings. These headings exist as Styles within my ~600 page document.

For instance, I have: 1.1.1 The Quick Brown Fox.

What I want is: 1.1.1 (XXxx) The Quick Brown Fox.

I created this macro which I then customized for each of the 6 heading levels in my document.

Public Sub InsertFOUOH1()
'Inserts U//FOUO before all first order Headings)
'Macro works on whole document
    Dim doc As Document
    Dim para As Paragraph

    Const MyText = "(U//FOUO) "
    Application.ScreenUpdating = False
    Set doc = ActiveDocument

    For Each para In doc.Paragraphs
        If para.Style = doc.Styles(wdStyleHeading1) Then
        para.Range.InsertBefore (MyText)
End If
Next para 
End Sub

This code is flawed/broken but I cannot find a solution. This works on Heading Levels 1-3. It fails on Heading Levels 4-6. The document is long and my assumption is that the sheer quantity of level 4 headings and greater causes the flawed code to fail. The code simply never completes at these heading levels.

This seems to be the part of the code that is incorrect:

For Each para In doc.Paragraphs
If para.Style = doc.Styles(wdStyleHeading1) Then
para.Range.InsertBefore (MyText)

I've tried dozens of variations on my macro and they all seem to fail at this point. In debugging, the debugger simply jumps right over the "If / Then" lines. They never get highlighted in yellow when debugging.

My understanding is that you can't programmatically select a paragraph in VBA. My heading levels are paragraphs to Word. So, my line "para.Range.InsertBefore (Mytext)" may not make any sense to the code. I tried creating a Range to make the macro work (Ranges have a 'Selection' property) but I'm doing something wrong.

I would certainly appreciate any advice about correcting my code.

Upvotes: 0

Views: 2306

Answers (1)

Jean-Pierre Oosthuizen
Jean-Pierre Oosthuizen

Reputation: 2683

Used the following script as a test:

Public Sub InsertFOUOH1()
'Inserts U//FOUO before all first order Headings)
'Macro works on whole document
    Dim doc As Document
    Dim para As Paragraph

    Const MyText = "(U//FOUO) "
    Application.ScreenUpdating = False
    Set doc = ActiveDocument

    For Each para In doc.Paragraphs
        If para.Style = doc.Styles(wdStyleHeading1) Then para.Range.InsertBefore ("Level 1")
        If para.Style = doc.Styles(wdStyleHeading2) Then para.Range.InsertBefore ("Level 2")
        If para.Style = doc.Styles(wdStyleHeading3) Then para.Range.InsertBefore ("Level 3")
        If para.Style = doc.Styles(wdStyleHeading4) Then para.Range.InsertBefore ("Level 4")
        If para.Style = doc.Styles(wdStyleHeading5) Then para.Range.InsertBefore ("Level 5")
        If para.Style = doc.Styles(wdStyleHeading6) Then para.Range.InsertBefore ("Level 6")
        If para.Style = doc.Styles(wdStyleHeading7) Then para.Range.InsertBefore ("Level 7")
        If para.Style = doc.Styles(wdStyleHeading8) Then para.Range.InsertBefore ("Level 8")
        If para.Style = doc.Styles(wdStyleHeading9) Then para.Range.InsertBefore ("Level 9")
    Next para
End Sub

The First time I tried it only worked to wdStyleHeading7 and I saw this was due to my Heading Styles only going up to Level 7, even though there was a 1.1.1.1.1.1.1.1 (8th Level) and a 9th level in my Document.

I then added the 8th and 9th Level Style to my Styles by selecting the text and using the Update heading to Match Selection. Once the 8th and 9th Heading Styles were added it then added the Text before the Heading Text.

Edit:

I tested it now with the para.Range.InsertBefore (MyText) and it worked fine too, due it ist simply adding the text

Upvotes: 2

Related Questions