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
'   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
'
'   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 v2/28/2007"    ' 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
    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
    Dim Font_Name As String
    Font_Name = "Arial"
    Song_Font_Size = 10
    Copyright_Font_Size = 8
    Title_Font_Size = 10
    
'   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")
    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")

No_Ini:

'   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
'   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
'   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 = True
        .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 = True
        .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 = True
        .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 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
    
'   Fix Special 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 = 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
    
'   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
'   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
    
'======================================================================================
    If Annotate = "False" Then GoTo Cleanup 'Skip the following if no annotations wanted

'   Show Intentionally blank pages
'   Go to Top
    Selection.HomeKey Unit:=wdStory
'   Show blank pages
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "<Text>^l^l</Text>"
        .Replacement.Text = "<Text> ^l^t---BLANK PAGE--- ^l^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

'   Prepare for Verse/Chorus Stanza annotation
'   Go to Top
    Selection.HomeKey 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 = 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
'   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
'   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
'   Remove empty "Subs"
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "<Sub>0</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
'   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

'   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 = "^l"
        .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

'   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
    
'   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

'   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

'   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
    If Orientation = "Landscape" Then ActiveDocument.PageSetup.Orientation = wdOrientLanscape

'   Setup page format
    With ActiveDocument.PageSetup
        .LineNumbering.Active = False
'        .Orientation = wdOrientPortrait
        .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(8.5)
        .PageHeight = InchesToPoints(11)
        .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 = True
        .LineBetween = False
        .Width = InchesToPoints(Column_Width)
        .Spacing = InchesToPoints(0.1)
    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
    
'   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 = 5
        .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)"
        .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