Sub SONG2SHOUT()
' 3/21/2006
' SONG2SHOUT Macro
' Converts Song Select format to ShoutSinger Format
'
'   Initialize file append name
    appendname = ""
'   Go to Top
    Selection.HomeKey Unit:=wdStory
'   Test first character of file to see if already in proper format
    Word1 = Selection.Words(1).Text
    If Word1 = "Title" Then GoTo FixID ' if already formatted, just update the ID and exit
'
    appendname = "_ShoutSinger Format.txt"
'   Start creating header
    Selection.HomeKey Unit:=wdStory
    Selection.TypeText Text:="Title: "
'   Remove unused stuff at bottom of page
    Selection.EndKey Unit:=wdStory
    Selection.MoveUp Unit:=wdParagraph, Count:=2, Extend:=wdExtend
    Selection.Delete Unit:=wdCharacter, Count:=1
    Selection.TypeBackspace
'   Find CCLI song number
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "CCLI"
        .Replacement.Text = ""
        .Forward = False
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    Selection.Delete Unit:=wdCharacter, Count:=10
'   Cut the CCLI number
    Selection.EndKey Unit:=wdLine, Extend:=wdExtend
    Selection.Cut
    Selection.HomeKey Unit:=wdStory
    Selection.MoveDown Unit:=wdLine, Count:=1
    Selection.TypeParagraph
    Selection.MoveUp Unit:=wdLine, Count:=1
    Selection.TypeText Text:="CCLI: "
'   Paste the CCLI number
    Selection.Paste
    Selection.TypeBackspace
'   Find the Author info
    Selection.EndKey Unit:=wdStory
    Selection.HomeKey Unit:=wdLine, Extend:=wdExtend
'   Cut the Author info
    Selection.Cut
    Selection.HomeKey Unit:=wdStory
    Selection.MoveDown Unit:=wdLine, Count:=1
    Selection.TypeParagraph
    Selection.MoveUp Unit:=wdLine, Count:=1
    Selection.TypeText Text:="Author: "
'   Paste the Author info
    Selection.Paste
'
'   Start Song ID tag
    Selection.HomeKey Unit:=wdLine
    Selection.MoveDown Unit:=wdLine, Count:=2
    Selection.TypeText Text:="Song ID:"
    Selection.MoveDown Unit:=wdLine, Count:=1
    Selection.TypeParagraph
    Selection.TypeParagraph
'
'   Find and cut copyright information
    Selection.EndKey Unit:=wdStory
    Selection.TypeBackspace
    Selection.MoveUp Unit:=wdParagraph, Count:=1, Extend:=wdExtend
    Selection.Cut
    Selection.HomeKey Unit:=wdStory
    Selection.MoveDown Unit:=wdLine, Count:=2
    Selection.TypeParagraph
    Selection.MoveUp Unit:=wdLine, Count:=1
'   Paste in copyright information
    Selection.TypeText Text:="Copyright: "
    Selection.Paste
    Selection.EndKey Unit:=wdStory
    Selection.TypeBackspace
    Selection.HomeKey Unit:=wdLine, Extend:=wdExtend
    Selection.Delete Unit:=wdCharacter, Count:=1
    Selection.TypeBackspace
'   Find SongID tag
    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "Song ID:"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    Selection.HomeKey Unit:=wdLine
'   Go down 1 lines and put in Notes: tag
    Selection.MoveDown Unit:=wdLine, Count:=1
    Selection.TypeText Text:="Notes: Here is the right margin---->"
'   Go down 1 lines and put in Playorder: tag
    Selection.HomeKey Unit:=wdLine
    Selection.MoveDown Unit:=wdLine, Count:=1
    Selection.TypeText Text:="PlayOrder:"
    Selection.TypeParagraph
'
'   Go to top and move down below header
    Selection.HomeKey Unit:=wdStory
    Selection.MoveDown Unit:=wdParagraph, Count:=7
'   Fix Verse Tags
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "(Verse [0-9])"
        .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
'   Fix Chorus Tags
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "(Chorus [0-9])"
        .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
'   Remove this SongSelect tag since not used by ShoutSinger
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "Misc ?"
        .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 tags for Bridges
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "(BRIDGE)"
        .Replacement.Text = "Bridge:"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
'   Fix tags for Endings:
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "(ENDING)"
        .Replacement.Text = "Ending:"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

FixID:
'   Find and fix Song ID tag
    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "Song ID:"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.EndKey Unit:=wdLine, Extend:=wdExtend
    Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    Selection.TypeText Text:=" "
'
'   Go back to the top and start work creating the Song ID from the Title info
    Selection.HomeKey Unit:=wdStory
    Selection.EndKey Unit:=wdLine
'   Put temp padding at end of Title
    Selection.TypeText Text:="zzzzzzzz"
'   Fill in the Song ID tag
   Selection.HomeKey Unit:=wdStory
   Selection.Find.ClearFormatting
    With Selection.Find
        .Text = ":"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    Selection.MoveRight Unit:=wdCharacter, Count:=2
'   Copy the first 8 chars of the Title
    Selection.MoveRight Unit:=wdCharacter, Count:=8, Extend:=wdExtend
    Selection.Copy
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "Song ID:"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    Selection.MoveRight Unit:=wdCharacter, Count:=1
'   Song ID tag starts with "a-"
    Selection.TypeText Text:=" a-"
'   Paste in the first 8 chars of the song title
    Selection.Paste
'   Go to the top
    Selection.HomeKey Unit:=wdStory
'   Remove padding from Title
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "zzzzzzzz"
        .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
'   Now copy the right 8 characters of the title
    Selection.HomeKey Unit:=wdStory
    Selection.EndKey Unit:=wdLine
    Selection.MoveLeft Unit:=wdCharacter, Count:=8, Extend:=wdExtend
    Selection.Copy
    Selection.HomeKey Unit:=wdLine
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "Song ID:"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    Selection.EndKey Unit:=wdLine
'   Paste in the last 8 chars of the song title
    Selection.Paste
'   Skip over the "a-" part of the Song ID
    Selection.HomeKey Unit:=wdLine
    Selection.MoveRight Unit:=wdCharacter, Count:=11
    Selection.EndKey Unit:=wdLine, Extend:=wdExtend
    Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
'   Remove spaces & other unwanted stuff from Song ID field
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
'   Note - anything that is not a number or alphabet char is removed
        .Text = "[!a-z,A-Z,0-9]"
        .Replacement.Text = ""
        .Forward = True
' !!! Note - Use wdFindStop so that replacements are only done in selected area
        .Wrap = wdFindStop
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = True
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
'   Remove any commas from Song ID field
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = ","
        .Replacement.Text = ""
        .Forward = True
' !!! Note - Use wdFindStop so that replacements are only done in selected area
        .Wrap = wdFindStop
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
  
'   Convert paragraph mark to line break
'   Go to top
    Selection.HomeKey Unit:=wdStory
    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

'   Convert tabs to spaces
'   Go to top
    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "^t"
        .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 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 = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Wend    ' End While loop

'   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

'   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^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
    Wend    ' End While loop

'   Setup page format
    With ActiveDocument.PageSetup
        .LineNumbering.Active = False
        .Orientation = wdOrientPortrait
        .TopMargin = InchesToPoints(0.5)
        .BottomMargin = InchesToPoints(0.5)
        .LeftMargin = InchesToPoints(1.25)
        .RightMargin = InchesToPoints(0.5)
        .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 = True
        .KeepTogether = True
        .PageBreakBefore = True
        .NoLineNumber = False
        .Hyphenation = True
        .FirstLineIndent = InchesToPoints(0)
        .OutlineLevel = wdOutlineLevelBodyText
        .CharacterUnitLeftIndent = 0
        .CharacterUnitRightIndent = 0
        .CharacterUnitFirstLineIndent = 0
        .LineUnitBefore = 0
        .LineUnitAfter = 0
    End With
    
'   Set Font
    Selection.WholeStory
    With Selection.Font
    .Name = "Arial"
    .Size = 12
    .Bold = False
    .Italic = False
    End With

'   Go to the top
    Selection.HomeKey Unit:=wdStory

'   Save the file as a text file, appending "ShoutSinger Format"
    myDocname = ActiveDocument.FullName
    pos = InStr(myDocname, ".")
    If pos > 0 Then
        myDocname = Left(myDocname, pos - 1)
        myDocname = myDocname & appendname
'        myDocname = myDocname & "_ShoutSinger Format.txt"
        ActiveDocument.SaveAs FileName:=myDocname, FileFormat:=wdFormatText
    End If
End Sub