Numbered Outline Continuation Headings

rdross51 · #16 03-23-2015, 01:25 AM

While doing further research and testing, I discovered this script does not caputre my Heading 2 TOC or Heding 3 TOC styles. They are the same as Heading 2 & 3 respectively but are used when the title must appear in the Table of Contents. Also, I'm not liking the bookmark tagging concept. Your script finds the heading to add the bookmark so why can it access the cross-reference function like you would normally do manually?

rdross51 · #17 01-02-2016, 10:07 PM

Your macro run great. Is there anyway to increment the bookmark for subsequent continuation headings? If I add more than one, when I update the fields, all cross references refer to the last bookmark.

rdross51 · #18 01-02-2016, 10:13 PM

Is there any way to increment the bookmark? The current macro only uses one bookmark so if there are multiple continuation headings, when the fields are updated, all the cross-referencing changes to the last entry.

Irene H · #19 07-10-2016, 06:06 PM

Hello,

I am working on something similar -

I've only gone to level 3 Heading, and still have a bit to do with building the rest of the clause number. This might help you get started. (I haven't included the full code below, but hopefully will give you a start).

Do While i <= ActiveDocument.Paragraphs.Count
Set para = ActiveDocument.Paragraphs(i)
Select Case (para.Style)

Case "Heading 1": ' this is the major heading
iHeading1 = iHeading1 + 1
sHeading1 = para.Range

If iHeading1 < 1 Then
sClauseH1 = ""
Else: sClauseH1 = Format(iHeading1, Text) & "."

End If

'Reset Heading 2 and 3
iHeading2 = 0
sHeading2 = ""
iHeading3 = 0
sHeading3 = ""

Case "Heading 2": ' this is the level 2 heading
iHeading2 = iHeading2 + 1
sHeading2 = para.Range
If iHeading2 < 1 Then
sClauseH2 = ""
Else: sClauseH2 = Format(iHeading2, Text) & "."

End If
'Reset Heading 3
iHeading3 = 0
sHeading3 = ""

Case "Heading 3" ' this is the level 3 heading
iHeading3 = iHeading3 + 1
sHeading3 = para.Range

If iHeading3 < 1 Then
sClauseH3 = ""
Else: sClauseH3 = Format(iHeading2, Text) & "."

End If

Case "Normal":
' we want to copy the text (and paste all our variables in the excel spreadsheet)
sString = para.Range

Dim rng As Range
Dim strnum As String
ActiveDocument.ConvertNumbersToText
Set rng = Selection.Paragraphs(1).Range
sClause = sClauseH1 & sClauseH2 & sClauseH3 & Left(sString, InStr(sString, vbTab))
ActiveDocument.Undo

rdross51 · #20 08-19-2017, 02:33 AM

Incorrect posting of replay and since I can't find a way to delete it, Iv'e changed the test. Please disregard.

rdross51 · #21 08-19-2017, 02:40 AM

Although the last iteration from Guessed (dated 3/6/2015) works and can be repeated throughout the document, it applies the same bookmark name to each continuation heading so when you update the document (and fields), all references change to the last entry. I still am unable to figure out how to increment the bookmark so that each continuation heading will have a unique name. I am not a programmer and I've hit a wall on this. If no one can provide a free solution, I am at the point were I am willing to pay for one.

rdross51 · #22 08-19-2017, 02:42 AM

Although the last iteration from Guessed (dated 3/6/2015) works and can be repeated throughout the document, it applies the same bookmark name to each continuation heading so when you update the document (and fields), all references change to the last entry. I still am unable to figure out how to increment the bookmark so that each continuation heading will have a unique name. I am not a programmer and I've hit a wall on this. If no one can provide a free solution, I am at the point were I am willing to pay for one.

rdross51 · #23 08-19-2017, 02:43 AM

Although the last iteration from Guessed (dated 3/6/2015) works and can be repeated throughout the document, it applies the same bookmark name to each continuation heading so when you update the document (and fields), all references change to the last entry. I still am unable to figure out how to increment the bookmark so that each continuation heading will have a unique name. I am not a programmer and I've hit a wall on this. If no one can provide a free solution, I am at the point were I am willing to pay for one. Here was the last code provided.
Sub ProofOfConcept()
'macro by Andrew Lockton
Dim aRng As Range, iLev As Integer
Set aRng = ActiveDocument.Bookmarks("\page").Range
aRng.InsertParagraphBefore
With aRng.Paragraphs(1)
.Style = "Normal"
.OutlinePromote
iLev = .OutlineLevel
If iLev > 3 Then
.Style = "Normal"
aRng.Collapse Direction:=wdCollapseStart
aRng.Select
Selection.GoTo What:=wdGoToHeading, Which:=wdGoToPrevious, Count:=1
While Selection.Paragraphs(1).OutlineLevel <> iLev - 1
Selection.GoTo What:=wdGoToHeading, Which:=wdGoToPrevious, Count:=1
Wend

ActiveDocument.Bookmarks.Add Name:="ABC", Range:=Selection.Range
aRng.InsertAfter " continued"
aRng.Collapse Direction:=wdCollapseStart
ActiveDocument.Fields.Add Range:=aRng, Text:="Ref ABC \w \h"
aRng.Select
Else
aRng.Paragraphs(1).Range.Delete
End If
End With
End Sub

gmayor · #24 08-19-2017, 04:39 AM

From what I understand from your dilemma, you wish to insert an incremented bookmark name each time the macro is run. You can do that with a couple of additional functions e.g. as shown below. I have not tested the concept of the macro itself, only the bookmark issue. The first time the macro is run, the bookmark added is called ABC, the next time ABC1 then ABC2 etc.

You can test the process with

Code:

Sub Macro1()
Dim strName As String
    strName = "ABC"
    strName = BookmarkUnique(strName, ActiveDocument)
            ActiveDocument.Bookmarks.Add Name:=strName, Range:=Selection.Range
End Sub

Code:

Option Explicit

Sub ProofOfConcept()
'macro by Andrew Lockton
'Graham Mayor - http://www.gmayor.com - Last updated - 19 Aug 2017
Dim aRng As Range, iLev As Integer
Dim strName As String
    strName = "ABC"
    Set aRng = ActiveDocument.Bookmarks("\page").Range
    aRng.InsertParagraphBefore
    With aRng.Paragraphs(1)
        .Style = "Normal"
        .OutlinePromote
        iLev = .OutlineLevel
        If iLev > 3 Then
            .Style = "Normal"
            aRng.Collapse direction:=wdCollapseStart
            aRng.Select
            Selection.GoTo What:=wdGoToHeading, which:=wdGoToPrevious, Count:=1
            While Selection.Paragraphs(1).OutlineLevel <> iLev - 1
                Selection.GoTo What:=wdGoToHeading, which:=wdGoToPrevious, Count:=1
            Wend
            strName = BookmarkUnique(strName, ActiveDocument)
            ActiveDocument.Bookmarks.Add Name:=strName, Range:=Selection.Range
            aRng.InsertAfter " continued"
            aRng.Collapse direction:=wdCollapseStart
            ActiveDocument.Fields.Add Range:=aRng, Text:="Ref " & strName & " \w \h"
            aRng.Select
        Else
            aRng.Paragraphs(1).Range.Delete
        End If
    End With
End Sub

Private Function BookmarkUnique(strBookmark As String, oDoc As Document) As String
'Graham Mayor - http://www.gmayor.com - Last updated - 19 Aug 2017
Dim lngB As Long: lngB = 1
Dim lngName As Long
    lngName = Len(strBookmark)
    Do While BMExists(strBookmark, oDoc) = True
        strBookmark = Left(strBookmark, lngName) & lngB
        lngB = lngB + 1
    Loop
    'Reassemble the filename
    BookmarkUnique = strBookmark
lbl_Exit:
    Exit Function
End Function

Private Function BMExists(strbmName As String, oDoc As Document) As Boolean
'Graham Mayor - http://www.gmayor.com - Last updated - 19 Aug 2017
Dim oBm As Bookmark
    For Each oBm In oDoc.Bookmarks
        If oBm.Name = strbmName Then
            BMExists = True
            Exit For
        End If
    Next oBm
lbl_Exit:
    Exit Function
    Set oBm = Nothing
End Function

rdross51 · #25 08-19-2017, 06:06 AM

Failed at " strName = BookmarkUnique(strName, ActiveDocument)"
Received compile error "sub or function not defined" with BookmarkUnique highligted

gmayor · #26 08-19-2017, 06:11 AM

Did you copy all the code?

rdross51 · #27 08-19-2017, 07:08 AM

My bad. I didn't scroll down for the other two subs. Everything seems to be working. The only issue I have to figure out is how to select two alternate headings. I have at Heading 2 and a Heading 3 but also have a Heading 2 TOC and Heading 3 TOC for Table of Contents (we only want select Heading 2 or 3 to show in the TOC). The current macro does not recognize the TOC Headings. I'll play with it some more to see if I can figure it out unless you have another brilliant idea. Your help was and is greatly appreciated.

rdross51 · #28 09-09-2017, 04:46 AM

I've tested the macro and there is one small glitch that I haven't been able to overcome. I have two different Heading 3 styles; one called Heading 3 and the other Heading 3 TOC. They are identical but the Heading 3 TOC was necessary to show in the Table of Contents as I don't want all Heading 3s to show in the TOC. If I run the macro after a Heading 3 TOC, it goes back and bookmarks the last Heading 3 and not the Heading 3 TOC. Is there someway to get the macro to recognize either one?

Guessed · #29 09-09-2017, 06:44 PM

The macro uses Outline Levels which is a paragraph level format option associated with a style. Have you tried changing the Outline Levels of the styles involved?

In current versions of Word, it appears we can no longer change the outline level of the "Heading x" series of styles but there is nothing to stop you changing the 'Heading 3 TOC" style to either have or not have an outline level eg

Code:

ActiveDocument.Styles("Heading 3 TOC").ParagraphFormat.OutlineLevel = wdOutlineLevel1
'or
ActiveDocument.Styles("Heading 3 TOC").ParagraphFormat.OutlineLevel = wdOutlineLevelBodyText

rdross51 · #30 09-10-2017, 07:41 AM

So you are saying if I insert:

ActiveDocument.Styles("Heading 3 TOC").ParagraphFormat.OutlineLevel = wdOutlineLevel3

the macro would pick either Heading 3 or Heading 3 TOC? If so, where would this line be inserted in the above code?

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Capturing numbered headings	jbvalen	Word VBA	5	05-04-2017 05:03 PM
Word Mixing Numbered Headings with Numbered List	Tess0	Word	11	07-15-2014 05:25 AM
Headings and Number Outline Problem (MS Office 2008)	triodia	Word	2	05-07-2012 02:03 AM
numbered headings	Caroline	Word	5	03-14-2011 09:09 AM
XML marking of Auto-numbered Headings	crose	Word	0	12-17-2009 09:55 PM