To give you an idea of what can be achieved, try running the following version of the macro on your existing Study Guide. Before doing so, though, delete all the content from your existing Table of Contents, then, to replace it, press Ctrl-F9 to create a pair of field braces, thus { }, then type 'TOC \o "1-2" \n "1-1" \h' between them, so you end up with:
{TOC \o "1-2" \n "1-1" \h}
This is the field code used for a Table of Contents that the macro will now populate via the application of Heading Styles to your document.
Code:
Sub ReformatStatuteText()
' Turn Off Screen Updating
Application.ScreenUpdating = False
Dim TrkStatus As Boolean ' Track Changes flag
With ActiveDocument
' Store current Track Changes status, then switch off
TrkStatus = .TrackRevisions
.TrackRevisions = False
With .Styles("TOC 1")
With .Font
.Size = 11
.Bold = True
.Italic = False
.ColorIndex = wdAuto
End With
.ParagraphFormat.Alignment = wdAlignParagraphCenter
End With
With .Styles("TOC 2")
With .Font
.Size = 11
.Bold = True
.Italic = False
.ColorIndex = wdAuto
End With
With .ParagraphFormat
.KeepWithNext = False
.KeepTogether = True
.RightIndent = InchesToPoints(0.5)
.LeftIndent = InchesToPoints(0.5)
.FirstLineIndent = InchesToPoints(-0.5)
.TabStops.Add Position:=InchesToPoints(6.5), Alignment:=wdAlignTabRight, Leader:=wdTabLeaderDots
End With
End With
With .Styles("Heading 1")
.Font.Bold = True
With .ParagraphFormat
.Alignment = wdAlignParagraphCenter
.LineSpacingRule = wdLineSpaceSingle
End With
End With
With .Styles("Heading 2").ParagraphFormat
.SpaceBefore = 6
.SpaceAfter = 6
.LineSpacingRule = wdLineSpaceSingle
End With
With .Styles("Heading 3").ParagraphFormat
.SpaceBefore = 6
.SpaceAfter = 6
.LineSpacingRule = wdLineSpaceSingle
End With
With .Range.Find
.ClearFormatting
.Replacement.ClearFormatting
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
'Delete tabs & spaces preceding paragraph breaks
.Text = "[^t ]@^13"
.Replacement.Text = "^p"
.Execute Replace:=wdReplaceAll
'Replace all double spaces with single spaces
.Text = "[ ]{2,}"
.Replacement.Text = " "
.Execute Replace:=wdReplaceAll
'Limit paragraph breaks and manual line breaks to one 'real' paragraph per set.
.Text = "[^13^11]{1,}"
.Replacement.Text = "^p"
.Execute Replace:=wdReplaceAll
'Delete 'Acts' paragraphs
.Text = "^13Acts [0-9]{4}*^13"
.Replacement.Text = "^p"
.Execute Replace:=wdReplaceAll
'ReFormat 'Title' paras
.Format = True
.Text = "TITLE ([0-9]{1,})[. ](*^13)"
.Replacement.Text = "Part \1 - \2"
.Replacement.Style = "Heading 1"
.Execute Replace:=wdReplaceAll
.Text = "Part [0-9]{1,}[!^13]@^13"
.Replacement.Text = "^&"
.Execute Replace:=wdReplaceAll
'ReFormat 'CHAPTER' paras
.Text = "CHAPTER [0-9]{1,}. (*^13)"
.Replacement.Text = "\1"
.Replacement.Style = "Heading 2"
.Execute Replace:=wdReplaceAll
.Text = "[0-9]{1,}.[0-9]{1,}.[0-9]{1,}*^13"
.Replacement.Text = "^&"
.Replacement.Style = "Heading 2"
.Execute Replace:=wdReplaceAll
'ReFormat 'CHAPTER' paras
.Format = False
.Text = "(Art. [0-9.]{1,})([A-Z])"
.Replacement.Text = "\1 \2"
.Execute Replace:=wdReplaceAll
.Text = "(Art. [0-9.]{1,} [!.]@.) ([!^13]*^13)"
.Replacement.Text = "\1^p\2"
.Execute Replace:=wdReplaceAll
.Format = True
.Text = "Art. [0-9.]{1,} [!.]@.^13"
.Replacement.Text = "^&"
.Replacement.Style = "Heading 3"
.Execute Replace:=wdReplaceAll
End With
.TablesOfContents(1).Update
' Restore original Track Changes status
.TrackRevisions = TrkStatus
End With
' Restore Screen Updating
Application.ScreenUpdating = True
End Sub
Amongst other things, your document will now have an active Table of Contents (i.e. clicking or ctrl-clicking on an entry will take you to that page).