Global SettingsChanged As Boolean 'Used by songsheet.ini form ' ' Songsheet macro ' Extracts Song Lyrics from Media Shout(tm)3 .ssc scripts in proper playorder ' Works with Microsoft(tm) Word 2000, 2002 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 . ' 8/8/07 - Added .ini feature to allow printing of the CCLI and Info fields. Also added .ini setting to allow printing of background pathnames. ' Fixed support of "<" and ">" characters in text blocks, to distinguish from "<" and ">" in XML code. ' 8/23/07 - Added support for real backslashes "\" in text blocks, removed potential hazard in wildcard filtering of embedded formating within text blocks. ' Changed special identifiers to $Zn$ format to allow preservation of "$" and "%" characters in text blocks. ' Replaced single backslash used in background file path name with $Z2$ identifier, to prevent being stripped out by XML "\* " filter ' 9/3/07 - Added Andy Kemp's filebrowser and an "Enable_File_Browser" songsheet.ini setting. ' Added a Default_Script_Folder .ini setting - used when the Songsheet.ini file is in the Word startup path - same path used by the .dot file . ' Added separate "Header_Italics" and "Footer_Italics" songsheet.ini settings ' Added support to convert Text Cues, Bible Cues and Comment Cues - Include_Text_Cue, Include_Bible_Cue and Include_Comment_Cue songsheet.ini settings ' Added ability to convert additional scripts - if filebrowser mode is turned on. ' Recommended location for the songsheet.ini file is now in the Word startup folder "C:\Documents and Settings\UserName\Application Data\Microsoft\Word\Startup" (same as the .dot file) ' If the songsheet.ini file is not there, but is found in the active document folder, the program will ask permission to copy the file to the Word Startup folder. ' Additional programming notes & comments added at the end. ' 10/3/07 - Included Andy Kemp's work to make the macro and buttons a Word Startup template (.dot) ' Added Andy Kemp's form to edit songsheet.ini settings. ' Fixed a few problems that occur when used with MediaShout3.2b678 and later due to new .ssc elements. ' Fixed a problem that can occur when annotating background paths, and including text cues, and the last cue is not a song cue. ' Fixed a problem that can occur if using an untitled cue ' Fixed a problem that can occur with XML elements that have negative numbered parameters ' Fixed a problem that deleted part of the Author field for songs with a one word title and the include background path names was turned off. ' ' 10/15/07 - Renamed macro as Songsheet_V2 released version. This will eliminate any conflicts for users who had previously installed "songsheet" in normal.dot ' ' To God be the Glory! ' R. Noar - songsheet .ssc XML to text conversion ' A. Kemp - filebrowser user interface & songsheet.ini form editor ' ' NOTES TO REMEMBER: See notes at end of file ........ ' '-------------------------------------------------- ' Function used with filebrowser Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _ "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long Private Type OPENFILENAME lStructSize As Long hwndOwner As Long hInstance As Long lpstrFilter As String lpstrCustomFilter As String nMaxCustFilter As Long nFilterIndex As Long lpstrFile As String nMaxFile As Long lpstrFileTitle As String nMaxFileTitle As Long lpstrInitialDir As String lpstrTitle As String flags As Long nFileOffset As Integer nFileExtension As Integer lpstrDefExt As String lCustData As Long lpfnHook As Long lpTemplateName As String End Type Sub SongSheet_V2() '------------------------------------------------------------------- ' Disclaimer Message Dim Msg, Style, Title, Response, MyString Msg = "By Clicking 'Yes', I agree to accept sole liability for the use of this program, and 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 2.0 - 10/15/07 " ' Define title. Response = MsgBox(Msg, Style, Title) If Response = vbNo Then GoTo Exit_Sub '------------------------------------------------------------------- ' Setup default document path Dim myDocPath As String myDocPath = Dialogs(wdDialogToolsOptionsFileLocations).Setting ' Default "My Documents" path ' Add a "\" at the end of the path, unless the setting is already followed by a "\" - ' which it will be if the setting is set to a root folder If Not Right$(myDocPath, 1) = "\" Then myDocPath = myDocPath + "\" End If '------------------------------------------------------------------- Set_Defaults: ' Default options & formatting 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 Header_Italics = False Footer_Italics = True Include_CCLI = False Include_Info = False Include_Background = False Include_Text_Cue = False Include_Bible_Cue = False Include_Comment_Cue = False Use_File_Browser = True ' Not exactly backwards compatible, but user can set whatever they want in their .ini file Default_Script_Folder = myDocPath 'defaults to "My Documents" ' End of Defaults ' Does SongSheet.dot exist in the Word Startup folder? Dim Word_Startup_Path As String Word_Startup_Path = Options.DefaultFilePath(wdStartupPath) Dim FileInQuestion As String FileInQuestion = Dir(Word_Startup_Path & "\songsheet.dot") ' If FileInQuestion = "" Then ' Msg = "We recommend that you copy Songsheet.dot and songsheet.ini to: " & Word_Startup_Path ' Style = vbOKOnly ' Define buttons. ' Title = "Notice" ' Define title. ' Response = MsgBox(Msg, Style, Title) ' End If ' Does a SongSheet.ini file exist in the Word Startup folder? FileInQuestion = Dir(Word_Startup_Path & "\songsheet.ini") If Not FileInQuestion = "" Then Ini_Path = Word_Startup_Path GoTo Load_Ini ' songsheet.ini file found End If Msg = "Songsheet.ini file not found in " & Word_Startup_Path & " - checking active document folder to see if it's there..." Style = vbOKOnly ' Define buttons. Title = "Notice" ' Define title. Response = MsgBox(Msg, Style, Title) ' Does a SongSheet.ini file exist in the same folder as the active document? FileInQuestion = Dir(ActiveDocument.Path & "\songsheet.ini") If FileInQuestion = "" Then Msg = "Songsheet.ini file not found in active document path - using default formatting." Style = vbOKOnly ' Define buttons. Title = "Notice" ' Define title. Response = MsgBox(Msg, Style, Title) GoTo No_Ini End If Ini_Path = ActiveDocument.Path Msg = "Songsheet.ini found - Would you like to have it copied to the Word Startup folder (Recommended)" Style = vbYesNo ' Define buttons. Title = "Found Songsheet.ini at " & ActiveDocument.Path ' Define title. Response = MsgBox(Msg, Style, Title) If Response = vbNo Then GoTo Load_Ini Dim Source_File As String Dim Destination_File As String Source_File = ActiveDocument.Path & "\songsheet.ini" Destination_File = Word_Startup_Path & "\songsheet.ini" FileCopy Source_File, Destination_File Load_Ini: ' Get parameters from the .ini file Top_Margin = System.PrivateProfileString(Ini_Path & "\songsheet.ini", "Format", "Top_Margin") Bottom_Margin = System.PrivateProfileString(Ini_Path & "\songsheet.ini", "Format", "Bottom_Margin") Left_Margin = System.PrivateProfileString(Ini_Path & "\songsheet.ini", "Format", "Left_Margin") Right_Margin = System.PrivateProfileString(Ini_Path & "\songsheet.ini", "Format", "Right_Margin") Orientation = System.PrivateProfileString(Ini_Path & "\songsheet.ini", "Format", "Orientation") Num_Columns = System.PrivateProfileString(Ini_Path & "\songsheet.ini", "Format", "Num_Columns") Column_Width = System.PrivateProfileString(Ini_Path & "\songsheet.ini", "Format", "Column_Width") Annotate = System.PrivateProfileString(Ini_Path & "\songsheet.ini", "Format", "Annotate") Split_Annotate = System.PrivateProfileString(Ini_Path & "\songsheet.ini", "Format", "Split_Annotate") Font_Name = System.PrivateProfileString(Ini_Path & "\songsheet.ini", "Format", "Font_Name") Song_Font_Size = System.PrivateProfileString(Ini_Path & "\songsheet.ini", "Format", "Song_Font_Size") Copyright_Font_Size = System.PrivateProfileString(Ini_Path & "\songsheet.ini", "Format", "Copyright_Font_Size") Title_Font_Size = System.PrivateProfileString(Ini_Path & "\songsheet.ini", "Format", "Title_Font_Size") Stanza_Annotate = System.PrivateProfileString(Ini_Path & "\songsheet.ini", "Format", "Stanza_Annotate") Blank_Page_Annotate = System.PrivateProfileString(Ini_Path & "\songsheet.ini", "Format", "Blank_Page_Annotate") Title_Page_Annotate = System.PrivateProfileString(Ini_Path & "\songsheet.ini", "Format", "Title_Page_Annotate") Header_Italics = System.PrivateProfileString(Ini_Path & "\songsheet.ini", "Format", "Header_Italics") Footer_Italics = System.PrivateProfileString(Ini_Path & "\songsheet.ini", "Format", "Footer_Italics") Include_Song_ID = System.PrivateProfileString(Ini_Path & "\songsheet.ini", "Format", "Include_Song_ID") Include_Lyrics = System.PrivateProfileString(Ini_Path & "\songsheet.ini", "Format", "Include_Lyrics") Insert_Page_Breaks = System.PrivateProfileString(Ini_Path & "\songsheet.ini", "Format", "Insert_Page_Breaks") Include_CCLI = System.PrivateProfileString(Ini_Path & "\songsheet.ini", "Format", "Include_CCLI") Include_Info = System.PrivateProfileString(Ini_Path & "\songsheet.ini", "Format", "Include_Info") Include_Background = System.PrivateProfileString(Ini_Path & "\songsheet.ini", "Format", "Include_Background") Include_Text_Cue = System.PrivateProfileString(Ini_Path & "\songsheet.ini", "Format", "Include_Text_Cue") Include_Bible_Cue = System.PrivateProfileString(Ini_Path & "\songsheet.ini", "Format", "Include_Bible_Cue") Include_Comment_Cue = System.PrivateProfileString(Ini_Path & "\songsheet.ini", "Format", "Include_Comment_Cue") Use_File_Browser = System.PrivateProfileString(Ini_Path & "\songsheet.ini", "Format", "Use_File_Browser") Default_Script_Folder = System.PrivateProfileString(Ini_Path & "\songsheet.ini", "Format", "Default_Script_Folder") ' Finished loading songsheet.ini settings Header_Italics_Bool = CBool(Header_Italics = "True") 'convert to boolean Footer_Italics_Bool = CBool(Footer_Italics = "True") 'convert to boolean ' Setup default script folder if parameter is present If Not Default_Script_Folder = "" Then myDocPath = Default_Script_Folder End If 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 Re_Entry: If Use_File_Browser = False Then ' 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 GoTo Start_Conversion End If '====================================================================================== ' File Browser Code: Dim OpenFile As OPENFILENAME Dim lReturn As Long Dim sFilter As String OpenFile.lStructSize = Len(OpenFile) OpenFile.hwndOwner = 0 OpenFile.hInstance = 0 sFilter = "MediaShout Script File (*.ssc)" & Chr(0) & "*.ssc" & Chr(0) OpenFile.lpstrFilter = sFilter OpenFile.nFilterIndex = 1 OpenFile.lpstrFile = String(257, 0) OpenFile.nMaxFile = Len(OpenFile.lpstrFile) - 1 OpenFile.lpstrFileTitle = OpenFile.lpstrFile OpenFile.nMaxFileTitle = OpenFile.nMaxFile OpenFile.lpstrInitialDir = myDocPath OpenFile.lpstrTitle = "Open a MediaShout Script File" OpenFile.flags = 0 lReturn = GetOpenFileName(OpenFile) If lReturn = 0 Then Exit Sub End If ScriptFile = Left(OpenFile.lpstrFile, InStr(OpenFile.lpstrFile, vbNullChar) - 1) 'ScriptFile is a String that contains the path of each selected item. Dim WordFile As String 'strip the end off the filepath and add in " - songsheet.doc" WordFile = Left(ScriptFile, Len(ScriptFile) - 4) & " - songsheet.doc" 'Copy and rename the file WordBasic.CopyFileA FileName:=ScriptFile, Directory:=WordFile Documents.Open FileName:=WordFile, _ ConfirmConversions:=True, _ Format:=wdOpenFormatEncodedText ' ' End of File Browser Code '============================================================================================== Start_Conversion: ' 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 Start_Processing ' Error Message Msg = "The input file is not a properly formatted script file!" Style = vbOKOnly + vbCritical ' Define buttons. Title = "File Format Error" ' Define title. Response = MsgBox(Msg, Style, Title) GoTo Conversion_Done 'Try again... Start_Processing: ' Set Font Selection.WholeStory With Selection.Font .Name = Font_Name .Size = Song_Font_Size End With ' Check to see if Text, Bible or Comment cues are to be included If Include_Text_Cue = "True" Or Include_Bible_Cue = "True" Or Include_Comment_Cue = "True" Then ' Go to Top Selection.HomeKey unit:=wdStory ' To make text cue processing work with lyric cleanup code Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = " elements, to avoid confusion with elements 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 anything within elements, to avoid confusion with elements 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 anything within
elements, since not needed 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 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 ' Fix case where the cue is not titled ***10/3/07 Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "" .Replacement.Text = "</CueType><Title>--Untitled--" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = False End With Selection.Find.Execute Replace:=wdReplaceAll ' GoTo Top Selection.HomeKey unit:=wdStory ' Eliminate negative numbered parameters ***10/3/07 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 ' Make Titles Bold & set italics if desired With ActiveDocument.Content.Find .ClearFormatting .Text = "(\*\)" .MatchWildcards = True .Wrap = wdFindContinue With .Replacement .ClearFormatting .Font.Bold = True .Font.Italic = Header_Italics_Bool .Text = "\1" End With .Execute Format:=True, Replace:=wdReplaceAll End With ' Go to Top Selection.HomeKey unit:=wdStory ' Fix Author field - if no Author field 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 ' Fix Copyright field - if no Copyright field 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 ' Fix CCLI field - if no CCLI field present 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 ' Fix Info field - if no Info field present 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 ' Make SongID italics With ActiveDocument.Content.Find .ClearFormatting .Text = "(\*\)" .MatchWildcards = True .Wrap = wdFindContinue With .Replacement .ClearFormatting .Font.Italic = Footer_Italics_Bool .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 = "(\*\)" .MatchWildcards = True .Wrap = wdFindContinue With .Replacement .ClearFormatting .Font.Italic = Footer_Italics_Bool .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 = "(\*\)" .MatchWildcards = True .Wrap = wdFindContinue With .Replacement .ClearFormatting .Font.Italic = Footer_Italics_Bool .Font.Size = Copyright_Font_Size .Text = "\1" End With .Execute Format:=True, Replace:=wdReplaceAll End With ' Go to Top Selection.HomeKey unit:=wdStory ' Make CCLI italics With ActiveDocument.Content.Find .ClearFormatting .Text = "(\*\)" .MatchWildcards = True .Wrap = wdFindContinue With .Replacement .ClearFormatting .Font.Italic = Footer_Italics_Bool .Font.Size = Copyright_Font_Size .Text = "\1" End With .Execute Format:=True, Replace:=wdReplaceAll End With ' Go to Top Selection.HomeKey unit:=wdStory ' Make Info italics With ActiveDocument.Content.Find .ClearFormatting .Text = "(\*\)" .MatchWildcards = True .Wrap = wdFindContinue With .Replacement .ClearFormatting .Font.Italic = Footer_Italics_Bool .Font.Size = Copyright_Font_Size .Text = "\1" End With .Execute Format:=True, Replace:=wdReplaceAll End With ' Go to Top Selection.HomeKey unit:=wdStory ' Make Backgound file pathname italics With ActiveDocument.Content.Find .ClearFormatting .Text = "(\*\)" .MatchWildcards = True .Wrap = wdFindContinue With .Replacement .ClearFormatting .Font.Italic = Footer_Italics_Bool .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 - eliminate double 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 - use ^l instead ' 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 = "&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 small e, grave accent ' Go to Top Selection.HomeKey unit:=wdStory Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "\&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 = "\&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 = "\&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 = "\&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 = "\&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 = "\&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 = "\&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 = "\&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 = "\&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 = "\&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 = "\\&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 = "&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;" .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 ' Go to Top Selection.HomeKey unit:=wdStory ' Replace line break with "$Z4$", since table will use as delimiter otherwise Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "^l" .Replacement.Text = "$Z4$" .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 - note that separator must be one character only. Any real "%" characters have already been replaced with $Z3$ ' 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 = "$Z4$" .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 = "\" .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 ' The following loop replaces "\" found in * elements with the $Z2$ identifier ' Must be done prior to the "Eliminate Formatting Junk" step below, otherwise pathnames get removed ' ' Go to Top Selection.HomeKey unit:=wdStory While 1 ' **** modified 10/15/07 to always run this loop - to fix a problem with "\" in pathnames causing Author info to be sometimes deleted 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 = True End With If Selection.Find.Execute = False Then GoTo Fix_Paths_End ' Replace single backslashes with $Z2$ indentifier only within elements With Selection.Find .Text = "\" .Replacement.Text = "$Z2$" .Forward = True .Wrap = wdFindStop .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll ' Move right Selection.MoveRight unit:=wdCharacter, Count:=1 Wend '------------------- Fix_Paths_End: ' Eliminate formatting junk sometimes present inside the pair, ' eg: \deftab1134\paperw12240\paperh15840\margl0\margt0\margr0\margb0\pard\plain\f0\fs64\b\cf3 ' \plain\f0\fs64\b\cf3 ' \pard\itap0\nowidctlpar\qc\sb288 ' Go to Top Selection.HomeKey unit:=wdStory Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "\\* " 'Note , any real backslashes in text blocks have already been replaced by $Z2$ .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 Multiple spaces Dim SPCnt SPCnt = 0 ' Initialize variable. While SPCnt < 8 ' 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 If Selection.Find.Execute = False Then GoTo MultSpcEnd Selection.Find.Execute Replace:=wdReplaceAll Wend ' End While loop MultSpcEnd: ' 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 < 8 ' 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 If Selection.Find.Execute = False Then GoTo CRLFEnd Selection.Find.Execute Replace:=wdReplaceAll Wend ' End While loop CRLFEnd: ' 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 = "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 '--------------------- 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 = "101" .Replacement.Text = " ^t-TITLE PAGE- ^l" .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 = "102" .Replacement.Text = "^t-BLANK PAGE- ^l" .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 = "\*\" .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 GoTo Song_Information ' Process_Lyrics: '======== Stanza Annotation =========================================================================== If Stanza_Annotate = "False" Then GoTo Song_Information '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 Selection.EndKey unit:=wdStory ' Include annotation into text fields Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "(\*\)*\" .Replacement.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 = "\(*)\*(\*\)" '*** 10/3/07 Change .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 = "" .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 = "0" .Replacement.Text = "$Z5$^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 = "1" .Replacement.Text = "$Z5$^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 = "2" .Replacement.Text = "$Z5$^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 = "3" .Replacement.Text = "$Z5$^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 "_" (using $Z6$ identifier) after type number Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "\(*)\" .Replacement.Text = "$Z6$\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 '=========================================== Song_Information: ' Done with lyric text, now work on song information ' Go to Top Selection.HomeKey unit:=wdStory ' Mark the end of the song Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "" .Replacement.Text = "$Z7$" .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 '------------ If background path names are included, do the following loop for each song While Include_Background = True 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 = True End With If Selection.Find.Execute = False Then GoTo Background_End Selection.Copy 'Copy the backround file pathname Selection.Find.ClearFormatting With Selection.Find .Text = "$Z7$" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With If Selection.Find.Execute = False Then GoTo Background_End '*** 10/3/07 Fix Selection.MoveLeft unit:=wdCharacter, Count:=1 Selection.TypeText Text:=Chr(11) 'Manual line feed Selection.TypeText Text:="Background: " Selection.Paste 'Paste the background file pathname Selection.TypeText Text:="" Selection.MoveRight unit:=wdCharacter, Count:=1 Wend '------------------- Background_End: ' ' Go to Top Selection.HomeKey unit:=wdStory ' Cleanup after Titles 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 = 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 = "\*\" .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 '----- Start work on Author, Copyright, SongID, etc fields after the last verse ' Go to Top Selection.HomeKey unit:=wdStory ' Fix Author field Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "" .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 = "\" .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 '----------- If Include_Song_ID = "True" Then GoTo Fix_Song_ID ' GoTo Top Selection.HomeKey unit:=wdStory ' Otherwise, Eliminate SongID info 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 Fix_Song_ID: ' Go to Top Selection.HomeKey unit:=wdStory ' Fix SongID field Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "" .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 '----------- If Include_CCLI = "True" Then GoTo Fix_CCLI ' GoTo Top Selection.HomeKey unit:=wdStory ' Otherwise, Eliminate CCLI info 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 Fix_CCLI: ' Go to Top Selection.HomeKey unit:=wdStory ' Fix CCLI field Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "" .Replacement.Text = "^lCCLI: " .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = False End With Selection.Find.Execute Replace:=wdReplaceAll '----------- If Include_Info = "True" Then GoTo Fix_Info ' GoTo Top Selection.HomeKey unit:=wdStory ' Otherwise, Eliminate Info info 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 Fix_Info: ' Go to Top Selection.HomeKey unit:=wdStory ' Fix Info field Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "" .Replacement.Text = "^lInfo: " .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = False End With Selection.Find.Execute Replace:=wdReplaceAll '----------- If Include_Background = "True" Then GoTo Background_OK ' GoTo Top Selection.HomeKey unit:=wdStory ' Otherwise, Eliminate Background Path info 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 Background_OK: ' ' Go to Top Selection.HomeKey unit:=wdStory ' Eliminate everything after last verse text up to the Author tag (follows the tag) 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 '---------------------- ' GoTo Top Selection.HomeKey unit:=wdStory ' Eliminate numbered parameters ***10/3/07 Works OK since stanza annotations are not enclosed in >< at this point 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 ' GoTo Top Selection.HomeKey unit:=wdStory ' Eliminate numbered types between and elements introduced in v3.2b678 ***10/3/07 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 ' GoTo Top Selection.HomeKey unit:=wdStory ' Eliminate numbered types between and elements introduced in v3.2b678 ***10/3/07 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 ' Cleanup after the End of Song Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "$Z7$*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 ' Fix "Less Than" char - this has to be done after the "Eliminate remaining code step above" ' Go to Top Selection.HomeKey unit:=wdStory Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "&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 - this has to be done after the "Eliminate remaining code step above" ' Go to Top Selection.HomeKey unit:=wdStory Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "&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 ' Go to Top Selection.HomeKey unit:=wdStory ' Replace those strange copyright symbols with normal copyright symbols Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "©" .Replacement.Text = "©" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = True .MatchWholeWord = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = False 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 "$Z5$" ' Find $ Key Selection.Find.ClearFormatting With Selection.Find .Text = "$Z5$" .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 = "$Z5$*$Z6$[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 = "$Z6$[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 ' Remove Sub for "0" subs (non-split stanzas) remaining in split-annotate mode Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "$Z6$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 '--------------------------- ' Restore identifiers back to plain text ' Go to Top Selection.HomeKey unit:=wdStory ' Restore real dollar signs, previously changed to $Z1$ identifier Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "$Z1$" .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 ' Restore real backslashes, previously changed to $Z2$ identifier Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "$Z2$" .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 ' Restore "%" , previously changed to $Z3$ identifier Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "$Z3$" .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 ' Restore "_" , previously changed to $Z6$ identifier Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "$Z6$" .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 ' Cleanup any remaining $Zn$ identifiers Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "$Z?$" .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 '=============================================================================== ' 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 MyDocName = ActiveDocument.FullName ActiveDocument.SaveAs FileName:=MyDocName, _ FileFormat:=wdFormatDocument Conversion_Done: If Use_File_Browser = False Then GoTo Exit_Sub: ' Process Another??? Msg = "Would you like to convert another script file? " Style = vbYesNo ' Define buttons. Title = "SongSheet " ' Define title. Response = MsgBox(Msg, Style, Title) If Response = vbYes Then ActiveDocument.Close GoTo Re_Entry: End If Exit_Sub: End Sub ' ' ' '============================================================================================================ ' NOTES TO REMEMBER: ' ' Notes on embedded formatting within blocks: ' \plain\f0\fs64\b\cf3 <- "f0" = font type, "fs64" = font size 32 (1/2 of the number), "\b" = bold (\i = italics, \ul = underline) ' note that if \b (or the others) are missing then those font attributes are "off" ' "cf3" = font color, will vary depending on use, but "cf3" is typically white font, "cf4" = yellow font, etc ' ' Real Backslashes in blocks are represented by double backslashes "\\" ' ' Special Identifiers used: ' % cue numbers - must be a single character since used in table as a separator ' $Z1$ any real "$" in text blocks ' $Z2$ real backslashes "\\" in text blocks ' $Z3$ real "%" character, since "%" used as table separator ' $Z4$ replaces ^l within tables ' $Z5$ precedes verse type for stanza annotations ' $Z6$ replaces "_" used in subs ' $Z7$ used to locate the end of each song ' ' CueType Codes: ' 0 = Text Cue ' 1 = Bible Cue ' 2 = Graphic Cue ' 3 = Video ' 5 = Lyric Cue ' 6 = Comment Cue ' 9 = Powerpoint Cue ' ' Page(screen) Types: ' 0123101102200