I have a macro for adding a continuation heading based outline levels. The outline numbering
is as follows:
1.0 (Heading 1)
1.1 (Heading 2 and Heading 2 TOC for when entry is needed for TOC)
1.1.1 (Heading 3 and Heading 3 TOC for when entry is needed for TOC)
A. (Heading 4)
1. (Heading 5)
a. (Heading 6)
1) (Heading 7)
a) (Heading 8)
We require a continuation heading for any page that starts with a Heading 4 or higher. Some
examples would be 6.1.2.B. (continued), 7.2.1.A.13. (continued), 5.3.2.B.2.b. (continued),
etc.
My current macro, listed below, is not very robust. Since it does not use unique bookmarks, I
had to change all the cross-references to text to prevent changing all cross-references to the
last bookmark location when the document fields are updated. It also will not recognized the
TOC headings.
Sub AltC()
' modification of macro by Andrew Lockton
' AltC Macro
' Insert Continuation Header
'
Dim aRng As Range, iLev As Integer
Set aRng = ActiveDocument.Bookmarks("\page").Range
aRng.InsertParagraphBefore
With aRng.Paragraphs(1)
.Style = "Continuation"
.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
Selection.Fields.Unlink
Application.Browser.Previous
Selection.MoveDown Unit:=wdLine, Count:=1
Else
aRng.Paragraphs(1).Range.Delete
End If
End With
End Sub
Any suggestions for improvement?