Sub SongSheet()
'   Extracts Song Lyrics from Media Shout(tm)3 .ssc scripts in proper playorder
'   Copy the <filename>.ssc script to <filename>.doc
'   Open the <filename>.doc file with Microsoft(tm) Word 2000 or 2003
'   REVISION LOG:
'   3/28/06 - This version includes the SongID at the bottom of the page
'   2/28/07 - This version allows various formatting options by using a "SongSheet.ini" file in the same folder as the source document.
'           - Provides options to annotate stanzas (verse, chord, bridge, etc), set font sizes, multiple columns, etc
'   5/20/07 - Quick fix for the /loch type special apostrophe
'   6/1/07  - Added .ini feature (Split_Annotate) to enable/disable annotation of stanzas (subs) that split across screens.
'   7/31/07 - Improved handling of /loch type special HTML Hex characters
'           - Added accent mark support for HTML Hex character codes: small e dieresis/umlaut, capitol E dieresis/umlaut, e acute, 
'		e grave, e circumflex, n tilde, inverted question mark & exclation mark
'           - Support of "<" and ">" HTML Hex characters . Thanks to http://www.iangraham.org/books/xhtml1/entity/en_test.html#key 
'		for listing of ISO HTML hex char codes!
'           - Fixed blank page annotation to work with Type "102" Shoutsinger inserted blank pages
'           - Now supports Title Page annotation as a .ini feature for Type "101" Shoutsinger inserted title pages
'           - Added .ini features to allow enable/disable annotation control of the following elements:
'               Stanza Annotation, Blank Page Annotation, Title Page Annotation, Song-ID, Lyrics, Page Breaks between Songs
'               Note that if Annotate=False, then Stanza, Blank Page and Title Page annotations are ALL turned off .
'
'   R.Noar
'   To God be the Glory!
'
'   Disclaimer Message
    Dim Msg, Style, Title, Response, MyString
    Msg = "By Clicking 'Yes', I agree to accept sole liability for the use of this program, agree to abide by all copyright laws, and agree to indemnify and hold harmless the author(s) of this program against any claim, loss or damages."
    Style = vbYesNo    ' Define buttons.
    Title = "Disclaimer - SongSheet, Version Date: 7/31/2007 Release "    ' Define title.
    Response = MsgBox(Msg, Style, Title)
    If Response = vbNo Then GoTo ExitSub

'   Test first character of file to see if it is formatted properly
'   Go to Top
    Selection.HomeKey Unit:=wdStory
    Char = Selection.Characters(1).Text
    If Char = "<" Then GoTo StartSub
'   Error Message
    Msg = "The input file is not formatted properly! It should be Unicode UTF-8 "
    Style = vbOKOnly + vbCritical ' Define buttons.
    Title = "File Format Error"    ' Define title.
    Response = MsgBox(Msg, Style, Title)
    GoTo ExitSub

StartSub:

'   Default format parameters - use these as default if not present in the .ini file
    Top_Margin = 0.5
    Bottom_Margin = 0.5
    Left_Margin = 1#
    Right_Margin = 0.5
    Dim Orientation As String
    Orientation = "Portrait"
    Num_Columns = 1
    Column_Width = 6.5
    Annotate = False ' For backwards compatibility
    Dim Font_Name As String
    Font_Name = "Arial"
    Song_Font_Size = 10
    Copyright_Font_Size = 8
    Title_Font_Size = 10
    Split_Annotate = False
    Stanza_Annotate = True ' For backwards compatibility
    Blank_Page_Annotate = False
    Title_Page_Annotate = False
    Include_Song_ID = True ' For backwards compatibility
    Include_Lyrics = True ' For backwards compatibility
    Insert_Page_Breaks = True
    Dim Header_Italics As Boolean
    Header_Italics = True
    
    
'   Does a SongSheet.ini file exist in the same folder as the active document?
    Dim FileInQuestion As String
    FileInQuestion = Dir(ActiveDocument.Path & "\songsheet.ini")
    If FileInQuestion = "" Then
    Msg = "Songsheet.ini file not found - using default formatting."
    Style = vbOKOnly    ' Define buttons.
    Title = "Notice"    ' Define title.
    Response = MsgBox(Msg, Style, Title)
    GoTo No_Ini
    End If

'   Get parameters from the .ini file
    Top_Margin = System.PrivateProfileString(ActiveDocument.Path & "\songsheet.ini", "Format", "Top_Margin")
    Bottom_Margin = System.PrivateProfileString(ActiveDocument.Path & "\songsheet.ini", "Format", "Bottom_Margin")
    Left_Margin = System.PrivateProfileString(ActiveDocument.Path & "\songsheet.ini", "Format", "Left_Margin")
    Right_Margin = System.PrivateProfileString(ActiveDocument.Path & "\songsheet.ini", "Format", "Right_Margin")
    Orientation = System.PrivateProfileString(ActiveDocument.Path & "\songsheet.ini", "Format", "Orientation")
    Num_Columns = System.PrivateProfileString(ActiveDocument.Path & "\songsheet.ini", "Format", "Num_Columns")
    Column_Width = System.PrivateProfileString(ActiveDocument.Path & "\songsheet.ini", "Format", "Column_Width")
    Annotate = System.PrivateProfileString(ActiveDocument.Path & "\songsheet.ini", "Format", "Annotate")
    Split_Annotate = System.PrivateProfileString(ActiveDocument.Path & "\songsheet.ini", "Format", "Split_Annotate")
    Font_Name = System.PrivateProfileString(ActiveDocument.Path & "\songsheet.ini", "Format", "Font_Name")
    Song_Font_Size = System.PrivateProfileString(ActiveDocument.Path & "\songsheet.ini", "Format", "Song_Font_Size")
    Copyright_Font_Size = System.PrivateProfileString(ActiveDocument.Path & "\songsheet.ini", "Format", "Copyright_Font_Size")
    Title_Font_Size = System.PrivateProfileString(ActiveDocument.Path & "\songsheet.ini", "Format", "Title_Font_Size")
    Stanza_Annotate = System.PrivateProfileString(ActiveDocument.Path & "\songsheet.ini", "Format", "Stanza_Annotate")
    Blank_Page_Annotate = System.PrivateProfileString(ActiveDocument.Path & "\songsheet.ini", "Format", "Blank_Page_Annotate")
    Title_Page_Annotate = System.PrivateProfileString(ActiveDocument.Path & "\songsheet.ini", "Format", "Title_Page_Annotate")
    Include_Song_ID = System.PrivateProfileString(ActiveDocument.Path & "\songsheet.ini", "Format", "Include_Song_ID")
    Include_Lyrics = System.PrivateProfileString(ActiveDocument.Path & "\songsheet.ini", "Format", "Include_Lyrics")
    Insert_Page_Breaks = System.PrivateProfileString(ActiveDocument.Path & "\songsheet.ini", "Format", "Insert_Page_Breaks")
    Header_Italics = System.PrivateProfileString(ActiveDocument.Path & "\songsheet.ini", "Format", "Header_Italics")


No_Ini:
'   "Annotate" is the master control for all annotations - if it is false, then turn off all annotations
    If Annotate = "True" Then GoTo No_Ini1
    Stanza_Annotate = False
    Blank_Page_Annotate = False
    Title_Page_Annotate = False
    Split_Annotate = False
    
No_Ini1:
'   No need to annotate lyrics if they are not included
    If Include_Lyrics = "False" Then Stanza_Annotate = False
    
'   Set Font
    Selection.WholeStory
    With Selection.Font
    .Name = Font_Name
    .Size = Song_Font_Size
    End With

'   Start processing....
'   Go to Top
    Selection.HomeKey Unit:=wdStory
'   Eliminate stuff inside of brackets
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "\{*\}"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

'   Go to Top
    Selection.HomeKey Unit:=wdStory
'   Eliminate extra brackets
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "}"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

'   Go to Top
    Selection.HomeKey Unit:=wdStory
'   Eliminate extra brackets
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "{"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

'   Go to Top
    Selection.HomeKey Unit:=wdStory
'   Eliminate anything within <strText> elements, to  avoid confusion with <Text> elements
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "\<strText\>*\</strText\>"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

'   Go to Top
    Selection.HomeKey Unit:=wdStory
'   Delete all "$" - need to use as delimiter later for Cue Numbers
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "$"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll


'   Go to Top
    Selection.HomeKey Unit:=wdStory
'   Change "CueNameType" elements - otherwise the remaining "<Type>" will mess up annotations later
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "CueNameType"
        .Replacement.Text = "Cue_Name_Type"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll


'   Go to Top
    Selection.HomeKey Unit:=wdStory
'   Delete "CueName" object to make searching for cues easier
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "CueName"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

'   Go to Top
    Selection.HomeKey Unit:=wdStory
'   Replace cue numbers with $
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "\<CueN*\>"
        .Replacement.Text = "$"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

'   Eliminate header info
'   Go to Top
    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "\<*\>$"
        .Replacement.Text = "$"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceOne

'   Go to Top
    Selection.HomeKey Unit:=wdStory
'   Delete all non-song cues (not type 5)
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "$\<CueType\>[!5]*\</CueN*\>"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

'   Eliminate first $
'   Go to Top
    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "$"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
    End With
    Selection.Find.Execute Replace:=wdReplaceOne

'   Go to Top
    Selection.HomeKey Unit:=wdStory
'   Make Titles Bold
    With ActiveDocument.Content.Find
        .ClearFormatting
        .Text = "(\<Title\>*\</Title\>)"
        .MatchWildcards = True
        .Wrap = wdFindContinue
        With .Replacement
        .ClearFormatting
        .Font.Bold = True
        .Text = "\1"
        End With
    .Execute Format:=True, Replace:=wdReplaceAll
    End With

'   Go to Top
    Selection.HomeKey Unit:=wdStory
'   Fix Author field - if no Author info
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "<Author/>"
        .Replacement.Text = "<Author></Author>"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

'   Go to Top
    Selection.HomeKey Unit:=wdStory
'   Fix Copyright field - if no Copyright info
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "<Copyright/>"
        .Replacement.Text = "<Copyright></Copyright>"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    
'   Go to Top
    Selection.HomeKey Unit:=wdStory
'   Make SongID italics
    With ActiveDocument.Content.Find
        .ClearFormatting
        .Text = "(\<SongID\>*\</SongID\>)"
        .MatchWildcards = True
        .Wrap = wdFindContinue
        With .Replacement
        .ClearFormatting
        .Font.Italic = Header_Italics
        .Font.Size = Copyright_Font_Size
        .Text = "\1"
        End With
    .Execute Format:=True, Replace:=wdReplaceAll
    End With

'   Go to Top
    Selection.HomeKey Unit:=wdStory
'   Make Author italics
    With ActiveDocument.Content.Find
        .ClearFormatting
        .Text = "(\<Author\>*\</Author\>)"
        .MatchWildcards = True
        .Wrap = wdFindContinue
        With .Replacement
        .ClearFormatting
        .Font.Italic = Header_Italics
        .Font.Size = Copyright_Font_Size
        .Text = "\1"
        End With
    .Execute Format:=True, Replace:=wdReplaceAll
    End With

'   Go to Top
    Selection.HomeKey Unit:=wdStory
'   Make Copyright italics
    With ActiveDocument.Content.Find
        .ClearFormatting
        .Text = "(\<Copyright\>*\</Copyright\>)"
        .MatchWildcards = True
        .Wrap = wdFindContinue
        With .Replacement
        .ClearFormatting
        .Font.Italic = Header_Italics
        .Font.Size = Copyright_Font_Size
        .Text = "\1"
        End With
    .Execute Format:=True, Replace:=wdReplaceAll
    End With

'   Eliminate the \pard
'   Go to Top
    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "\pard"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

'   Fix Paragraphs
'   Go to Top
    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "\par\par"
        .Replacement.Text = "\par"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

'   Fix Paragraphs
'   Go to Top
    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "\par"
        .Replacement.Text = " ^l"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

'   Fix Quotes
'   Go to Top
    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "&amp;quote;"
        .Replacement.Text = """"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    
'   Fix "Less Than" char
'   Go to Top
    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "&amp;lt;"
        .Replacement.Text = "<"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

'   Fix "Greater Than" char
'   Go to Top
    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "&amp;gt;"
        .Replacement.Text = ">"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

'   Fix small e, grave accent
'   Go to Top
    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "\&amp;apos;e8"
        .Replacement.Text = "è"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    
'   Fix small e, acute accent
'   Go to Top
    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "\&amp;apos;e9"
        .Replacement.Text = "é"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

'   Fix small e, circumflex accent
'   Go to Top
    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "\&amp;apos;ea"
        .Replacement.Text = "ê"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

'   Fix small "e" dieresis char
'   Go to Top
    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "\&amp;apos;eb"
        .Replacement.Text = "ë"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

'   Fix amall n tilde chars
'   Go to Top
    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "\&amp;apos;f1"
        .Replacement.Text = "ñ"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    
'   Fix Capital E, dieresis or umlaut mark
'   Go to Top
    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "\&amp;apos;cb"
        .Replacement.Text = "Ë"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

'   Fix Inverted question marks
'   Go to Top
    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "\&amp;apos;bf"
        .Replacement.Text = "¿"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

'   Fix Inverted exclamation marks
'   Go to Top
    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "\&amp;apos;a1"
        .Replacement.Text = "¡"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

'   Fix Tabs
'   Go to Top
    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "\tab"
        .Replacement.Text = " "
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    
'   Make HTML prefix for special char codes consistent
'   Go to Top
    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "\f0 \"
        .Replacement.Text = "\f0\"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

'   Fix Special Apostrophe's - HTML char \loch %92 type
'    GoTo Top
    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "\&amp;apos;92"
        .Replacement.Text = "'"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

'   Fix Special Apostrophe's - HTML char \loch %91 type
'    GoTo Top
    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "\&amp;apos;91"
        .Replacement.Text = "'"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

'   Fix Special Apostrophe's - \ type (and non-recognized accent marks....)
'   Go to Top
    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "\\&amp;apos;??"
        .Replacement.Text = "'"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

'   Fix Regular Apostrophe's
'   Go to Top
    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "&amp;apos;"
        .Replacement.Text = "'"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    
'   Eliminate special formatting prefix for HTML char codes - \loch type, trailing "\"
'   This comes after the apostrophe fixes
'   Go to Top
    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "\loch\f0\hich\f0\"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    
'   Eliminate special formatting prefix for HTML char codes - \loch type , no trailing "\"
'   This comes after the apostrophe fixes
'   Go to Top
    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "\loch\f0\hich\f0"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    
'   Fix Ampersands
'   Go to Top
    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "&amp;amp;"
        .Replacement.Text = "&"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

'   Go to Top
    Selection.HomeKey Unit:=wdStory
'   Replace paragraph marks with line breaks
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "^p"
        .Replacement.Text = "^l"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    
'   Eliminate Multiple CR/LF
    Dim CRLFCnt
    CRLFCnt = 0    ' Initialize variable.
    While CRLFCnt < 5    ' Test value of Counter.
    CRLFCnt = CRLFCnt + 1    ' Increment Counter.
'   Go to top
    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "^l^l"
        .Replacement.Text = "^l"
        .Forward = True
        .Wrap = wdFindStop
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Wend    ' End While loop

'   Go to top
    Selection.HomeKey Unit:=wdStory
'   Eliminate Multiple spaces
    Dim SPCnt
    SPCnt = 0    ' Initialize variable.
    While SPCnt < 5    ' Test value of Counter.
    SPCnt = SPCnt + 1    ' Increment Counter.
'   Go to top
    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "  "
        .Replacement.Text = " "
        .Forward = True
        .Wrap = wdFindStop
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Wend    ' End While loop

'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

'   Go to Top
    Selection.HomeKey Unit:=wdStory
'   Delete all "%" - need to use as line break later
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "%"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

'   Go to Top
    Selection.HomeKey Unit:=wdStory
'   Replace line break with "%", since table will use as delimiter otherwise
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "^l"
        .Replacement.Text = "%"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

'   Create table from text, using $ as separator
'   Table form is critical for processing on a "per song" basis below
'   Later on, the table will be converted back to text
    Selection.WholeStory
    Application.DefaultTableSeparator = "$"
    Selection.ConvertToTable Separator:=wdSeparateByDefaultListSeparator, _
        NumColumns:=1, InitialColumnWidth:=InchesToPoints(6.5), _
        Format:=wdTableFormatNone, ApplyBorders:=False, ApplyShading:=False, _
        ApplyFont:=True, ApplyColor:=True, ApplyHeadingRows:=True, ApplyLastRow:= _
        False, ApplyFirstColumn:=True, ApplyLastColumn:=False, AutoFit:=True, _
        AutoFitBehavior:=wdAutoFitFixed
    
'   Go to Top
    Selection.HomeKey Unit:=wdStory
'   Make sure no "$" remaining
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "$"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    
'   Go to Top
    Selection.HomeKey Unit:=wdStory
'   Put line breaks back in
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "%"
        .Replacement.Text = "^l"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    
'   Go to Top
    Selection.HomeKey Unit:=wdStory
'   Eliminate stuff before Titles
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "\<CueType*Title\>"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

'   Eliminate formatting junk
'   Go to Top
    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "\\* "
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

'   Eliminate leading spaces
'   Go to Top
    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "^l "
        .Replacement.Text = "^l"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    
'   Remove Number "0" elements - precedes Type 101 (Song Title Page) and Type 102 (Blank Page) entries
'   This step helps to avoid confusion caused by Type 101 and Type 102 elements
'   Go to Top
    Selection.HomeKey Unit:=wdStory
'   Remove Number "0" elements
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "<Number>0</Number>"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

'---------------------
    If Title_Page_Annotate = "False" Then GoTo No_Title_Page_Annotate 'Skip the following if title page annotation not wanted

'   Annotate Title page - Type "101" inserted as a Title page in ShoutSinger
'   Go to Top
    Selection.HomeKey Unit:=wdStory
'   Show Title pages
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "<Type>101</Type>"
        .Replacement.Text = "<Number></Number><Type></Type><Sub></Sub><Text> ^t-TITLE PAGE- ^l</Text>"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

'---------------------
No_Title_Page_Annotate:
    
    If Blank_Page_Annotate = "False" Then GoTo No_Blank_Page_Annotate 'Skip the following if blank page annotation not wanted

'   Show Intentionally blank pages - Type "102" inserted as a blank page in ShoutSinger
'   Go to Top
    Selection.HomeKey Unit:=wdStory
'   Show Blank pages
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "<Type>102</Type>"
        .Replacement.Text = "<Number></Number><Type></Type><Sub></Sub><Text>^t-BLANK PAGE- ^l</Text>"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

No_Blank_Page_Annotate:
    
'--------------------
    If Include_Lyrics = "True" Then GoTo Process_Lyrics
    
'   Go to Top
    Selection.HomeKey Unit:=wdStory
'   Remove Lyrics
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "\<Text\>*\</Text\>"
        .Replacement.Text = "<Text></Text>"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    
    GoTo Cleanup
   
'
Process_Lyrics:
    
'======== Stanza Annotation ===========================================================================
    If Stanza_Annotate = "False" Then GoTo Cleanup 'Skip the following if no stanza annotations wanted

'   Prepare for Verse/Chorus Stanza annotation
'   Go to BOTTOM & Replace in Reverse - so that the annotation info kept is nearest the <text>
    Selection.EndKey Unit:=wdStory
'   Include annotation into text fields
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "(\<Number\>*\</Sub\>)*\<Text\>"
        .Replacement.Text = "<Text>^l\1"
        .Forward = False
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

'   Go to Top
    Selection.HomeKey Unit:=wdStory
'   Swap Type and Number fields
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "(\<Number\>*\</Number\>)*(\<Type\>*\</Type\>)"
        .Replacement.Text = "\2\1"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

'   Go to Top
    Selection.HomeKey Unit:=wdStory
'   Remove blank subs
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "<Sub></Sub>"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    
'   Go to Top
    Selection.HomeKey Unit:=wdStory
'   Replace Type 0 with "Verse"
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "<Type>0</Type>"
        .Replacement.Text = "$^tVerse"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

'   Go to Top
    Selection.HomeKey Unit:=wdStory
'   Replace Type 1 with "Chorus"
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "<Type>1</Type>"
        .Replacement.Text = "$^tChorus"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

'   Go to Top
    Selection.HomeKey Unit:=wdStory
'   Replace Type 2 with "Bridge"
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "<Type>2</Type>"
        .Replacement.Text = "$^tBridge"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

'   Go to Top
    Selection.HomeKey Unit:=wdStory
'   Replace Type 3 with "Ending"
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "<Type>3</Type>"
        .Replacement.Text = "$^tEnding"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

'   Go to Top
    Selection.HomeKey Unit:=wdStory
'   Show "Subs" as "_" after type number
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "\<Sub\>(*)\</Sub\>"
        .Replacement.Text = "_\1"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
'
'   Annotation of Stanzas completed
'===========================================
Cleanup:

'   Go to Top
    Selection.HomeKey Unit:=wdStory
'   Cleanup after Titles
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "\</Title*\<Text\>"
        .Replacement.Text = "^l<Text>"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

'   Go to Top
    Selection.HomeKey Unit:=wdStory
'   Eliminate anything not in the text section
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "\</Text*\<Text\>"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

'-----------
    If Include_Song_ID = "False" Then GoTo No_Song_ID

'   Go to Top
    Selection.HomeKey Unit:=wdStory
'   Eliminate everything after last verse up to SongID info
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "\</Text*\</SongTitle\>"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

'   Go to Top
    Selection.HomeKey Unit:=wdStory
'   Fix SongID field
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "<SongID>"
        .Replacement.Text = "^lSong ID: "
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

    GoTo Song_ID_Done

No_Song_ID:  'Remove SongID if not wanted

'   Go to Top
    Selection.HomeKey Unit:=wdStory
'   Eliminate everything after last verse INCLUDING SongID info
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "\</Text*\</SongID\>"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

Song_ID_Done:
'-------------------
'   Go to Top
    Selection.HomeKey Unit:=wdStory
'   Fix Author field
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "<Author>"
        .Replacement.Text = "^lAuthor: "
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

'   Go to Top
    Selection.HomeKey Unit:=wdStory
'   Fix copyright section
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "\</Author*Copyright\>"
        .Replacement.Text = "^lCopyright: "
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

'   Go to Top
    Selection.HomeKey Unit:=wdStory
'   Cleanup after copyright section
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "\</Copyright*CueN*\>"
        .Replacement.Text = "^l"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

'   Eliminate any remaining code
'   Go to Top
    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "\<*\>"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

'   Go to Top
    Selection.HomeKey Unit:=wdStory
'   Just to make it look better...
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "words and music"
        .Replacement.Text = "Words and music"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

'----------------- This section removes Split Annotations, if they are not wanted
    If Split_Annotate = "True" Then GoTo Cleanup2
'   Otherwise, Remove Split Annotations

'   Go To Top
    Selection.HomeKey Unit:=wdStory
    
Remove_Split1:  'Loops & processes each line beginning with "$"
'   Find $ Key
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "$"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindStop
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    If Selection.Find.Execute = False Then
    GoTo Remove_Subs
    End If

    ' Select the line
    Selection.EndKey Unit:=wdLine, Extend:=wdExtend

'   Delete Annotation info for subs greater than "1"- ie: stanzas that split across screens
    With Selection.Find
        .Text = "$*_[2-9]^l"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindStop
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    .Execute Replace:=wdReplaceOne
    End With

'   Move right one char and then repeat the loop until all lines processed
    Selection.MoveRight Unit:=wdCharacter, Count:=1

    GoTo Remove_Split1

Remove_Subs:
'------------------
'   Go to Top
    Selection.HomeKey Unit:=wdStory
'   Remove All Sub Annotations
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "_[0-9]"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

'------------------
Cleanup2:
'   Go to Top
    Selection.HomeKey Unit:=wdStory
'   Cleanup any remaining $ keys
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "$"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

'   Go to Top
    Selection.HomeKey Unit:=wdStory
'   Remove Sub for "0" subs (non-split stanzas) remaining in split-annotate mode
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "_0"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

'   Go to Top
    Selection.HomeKey Unit:=wdStory
'   Remove any extra line feeds
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "^l^l^l"
        .Replacement.Text = "^l^l"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

'   Format Borders - no table borders
    Selection.WholeStory
    With Selection.Tables(1)
        .Borders(wdBorderLeft).LineStyle = wdLineStyleNone
        .Borders(wdBorderRight).LineStyle = wdLineStyleNone
        .Borders(wdBorderTop).LineStyle = wdLineStyleNone
        .Borders(wdBorderBottom).LineStyle = wdLineStyleNone
        .Borders(wdBorderHorizontal).LineStyle = wdLineStyleNone
        .Borders(wdBorderDiagonalDown).LineStyle = wdLineStyleNone
        .Borders(wdBorderDiagonalUp).LineStyle = wdLineStyleNone
        .Borders.Shadow = False
    End With
    
'   Go to Top
    Selection.HomeKey Unit:=wdStory
'   Convert Table to text
    Selection.Rows.ConvertToText Separator:=wdSeparateByParagraphs, _
        NestedTables:=True
    Selection.EndKey Unit:=wdStory
    Selection.Delete Unit:=wdCharacter, Count:=1

'---------------
    If Insert_Page_Breaks = "False" Then GoTo No_Page_Breaks
    
'   Go to Top
    Selection.HomeKey Unit:=wdStory
'   Insert Page Breaks
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "^p"
        .Replacement.Text = "^m"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

No_Page_Breaks:

'   Go to Top
    Selection.HomeKey Unit:=wdStory
'   Eliminate Blank Page at End
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "^m^p"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

'===============================================================================
'   Setup Page View and Formatting

'   Print Layout view
     If ActiveWindow.View.SplitSpecial = wdPaneNone Then
        ActiveWindow.ActivePane.View.Type = wdPrintView
    Else
        ActiveWindow.View.Type = wdPrintView
    End If

'   Page Orientation
    If Orientation = "Portrait" Then
    ActiveDocument.PageSetup.Orientation = wdOrientPortrait
    Pg_Width = 8.5
    Pg_Height = 11
    End If
    
    If Orientation = "Landscape" Then
    ActiveDocument.PageSetup.Orientation = wdOrientLandscape
    Pg_Width = 11
    Pg_Height = 8.5
    End If

'   Setup page format
    With ActiveDocument.PageSetup
        .LineNumbering.Active = False
        .TopMargin = InchesToPoints(Top_Margin)
        .BottomMargin = InchesToPoints(Bottom_Margin)
        .LeftMargin = InchesToPoints(Left_Margin)
        .RightMargin = InchesToPoints(Right_Margin)
        .Gutter = InchesToPoints(0)
        .HeaderDistance = InchesToPoints(0.5)
        .FooterDistance = InchesToPoints(0.5)
        .PageWidth = InchesToPoints(Pg_Width)
        .PageHeight = InchesToPoints(Pg_Height)
        .FirstPageTray = wdPrinterDefaultBin
        .OtherPagesTray = wdPrinterDefaultBin
        .SectionStart = wdSectionNewPage
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .VerticalAlignment = wdAlignVerticalTop
        .SuppressEndnotes = False
        .MirrorMargins = False
        .TwoPagesOnOne = False
        .GutterPos = wdGutterPosLeft
    End With

'   Format paragraphs
    Selection.WholeStory
    With Selection.ParagraphFormat
        .LeftIndent = InchesToPoints(0)
        .RightIndent = InchesToPoints(0)
        .SpaceBefore = 0
        .SpaceBeforeAuto = False
        .SpaceAfter = 0
        .SpaceAfterAuto = False
        .LineSpacingRule = wdLineSpaceSingle
        .Alignment = wdAlignParagraphLeft
        .WidowControl = True
        .KeepWithNext = False
        .KeepTogether = False
        .PageBreakBefore = False
        .NoLineNumber = False
        .Hyphenation = True
        .FirstLineIndent = InchesToPoints(0)
        .OutlineLevel = wdOutlineLevelBodyText
        .CharacterUnitLeftIndent = 0
        .CharacterUnitRightIndent = 0
        .CharacterUnitFirstLineIndent = 0
        .LineUnitBefore = 0
        .LineUnitAfter = 0
    End With
    
'==================================================================================
'   Setup Multiple columns, if desired
    If Num_Columns = 1 Then GoTo Multi_Done
'
'   Multiple Columns of text
    Selection.WholeStory
    With Selection.PageSetup.TextColumns
        .SetCount NumColumns:=Num_Columns
        .EvenlySpaced = False
        .LineBetween = False
        .Spacing = InchesToPoints(0.1)
        .Width = InchesToPoints(Column_Width)

    End With
'
'   Go to Top
    Selection.HomeKey Unit:=wdStory
'   Replace Page Breaks with Section breaks
    Selection.Find.ClearFormatting
    With Selection.Find
    .Text = "^m"
        Do While (.Execute(Forward:=True) = True = True)
            With Selection
            .Delete
            .InsertBreak Type:=wdSectionBreakNextPage
            End With
        Loop
    End With
    
'---------------
    If Include_Lyrics = "False" Then GoTo Multi_Done

'   GoTo Top
    Selection.HomeKey Unit:=wdStory
'   Temporarily Make Title Font very small to eliminate column wraps
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find.Replacement.Font
        .Size = 3
        .Bold = True
    End With
    With Selection.Find
        .Text = "(*^l)"
        .Replacement.Text = "\1"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .Font.Bold = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    
'   Put First Song Title into a new section, one column wide
    Selection.EndKey Unit:=wdLine, Extend:=wdExtend
    Selection.Cut
    Selection.InsertBreak Type:=wdSectionBreakContinuous
    Selection.MoveUp Unit:=wdLine, Count:=1
    With Selection.PageSetup.TextColumns
    .SetCount NumColumns:=1
    End With
    Selection.Paste
    Selection.GoTo What:=wdGoToSection, Which:=wdGoToNext, Count:=1, Name:=""

'   Put Remaining Song Titles into a new section, one column wide
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
    .Text = "^b"
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
    End With
    While Selection.Find.Execute
        Selection.MoveRight Unit:=wdCharacter, Count:=1
        Selection.EndKey Unit:=wdLine, Extend:=wdExtend
        Selection.Cut
        Selection.InsertBreak Type:=wdSectionBreakContinuous
        Selection.MoveUp Unit:=wdLine, Count:=1
        With Selection.PageSetup.TextColumns
        .SetCount NumColumns:=1
        End With
        Selection.Paste
        Selection.GoTo What:=wdGoToSection, Which:=wdGoToNext, Count:=1, Name:=""
    Wend
    
'=======================================================================================
Multi_Done:

'   GoTo Top
    Selection.HomeKey Unit:=wdStory
'   Restore Title Font
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find.Replacement.Font
        .Size = Title_Font_Size
        .Bold = True
    End With
    With Selection.Find
        .Text = "(*)^l"  'Note - ^l moved outside of the parens to support option of "Include_Lyrics = False"
        .Replacement.Text = "\1"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .Font.Bold = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    
'   Go to Top
    Selection.HomeKey Unit:=wdStory
'   Save the file as a .doc file, appending "SongSheet"
    MyDocName = ActiveDocument.FullName
    pos = InStr(MyDocName, ".")
    If pos > 0 Then
        MyDocName = Left(MyDocName, pos - 1)
        MyDocName = MyDocName & "_SongSheet.doc"
        ActiveDocument.SaveAs FileName:=MyDocName, _
        FileFormat:=wdFormatDocument
    End If

ExitSub:

End Sub