'############################################################
'#
'#      |*-----------------------------------*|
'#      || MACROS FOR FORMATTING GUITAR TABS ||
'#      |*-----------------------------------*|
'#                      Last modified: 12/01/06
'#                 by Andrew Noske
'#           (http://www.andrewnoske.net/)
'#
'#
'#  ABOUT:
'#      I use this set of Macros to automatically format guitar tabs
'#      (such as those found at http://www.guitartablab.com/) so they
'#      are prettier, easier to read (I also like to use MS Word to fit
'#      one song per page).
'#      These macros include:
'#          o GUITAR_TAB__FORMAT_WHOLE_DOCUMENT - Executes all the following
'#              three macros over WHOLE document
'#          o GUITAR_TAB__Notes_To_Bold - Finds all notes and makes them bold
'#              (from cursor to end of document)
'#          o GUITAR_TAB__Special_Characters - Finds special words (including:
'#               "verse", "chorus", etc), makes them italic and converts them to
'#              uppercase (if not already)
'#          o GUITAR_TAB__Special_Words_To_Italics - Finds special characters
'#              (including "[", "-", "#", etc) and changes their font/formatting.
'#
'#
'#  INSTRUCTIONS:
'#
'#    INSTALLING MACROS:
'#       To use these Macro in any document: open Microsoft Word,
'#       then click "Tools >> Macros >> Macros (Alt+F8)", make
'#       sure "macros in:" says "all active templates and documents",
'#       and then click "create".
'#       Now select all the text is this file you are reading (Ctrl+A),
'#       copy it (Ctrl+C) and paste/append (Ctrl+V) it to the end of the Macro "Module"
'#       in the Visual Basic window.
'#       Exit the Visual Basic window, and in MS Word press (Alt+F8),
'#       and now you can run these Macros by double clicking them!
'#
'#    USING THESE GUITAR TAB MACROS:
'#      o Copy and paste a guitar tab directly from the internet into MS Word;
'#        select "keep text only" as you paste
'#      o Press (Alt-F8) select "GUITAR_TAB__FORMAT_WHOLE_DOCUMENT" and run - this is the
'#        easiest way to process a document, because this one Macro runs most of the others.
'#        If you are familiar with Macros you can read what each macro does and modify the code.
'#          o BEWARE:   You can 't undo a macro operation, so save first.
'#          o WARNING:  Most of my macros execute until the end of the document and
'#                      therefore may take a few minutes since if the document is really large.
'#
'#    FURTHER TIPS:
'#
'#      I highly suggest using styles to further format your guitar tabs -
'#      keep all your favourite songs in one Word document, modify each song so
'#      it fits on a single page, and create a table of contents
'#      (such that it lists all your songs).
'#      On my website (http://noske.krimzon.net/) I have my own collection of favourite
'#      tabs/songs which demonstrates how this is done.
'#
'############################################################



'-----------------------------------------------------
Sub GUITAR_TAB__FORMAT_WHOLE_DOCUMENT()
'
' Changes formatting of entire document to make guitar tab
' easier to read, by changes notes to bold, and special words to italics.
'
' NOTE: This method calls most of the other methods.
'
'
    '## CHANGE ALL TEXT TO "Courier New"
    Selection.WholeStory
    Selection.Font.Name = "Courier New"
    Selection.MoveLeft Unit:=wdCharacter, Count:=1

    '## CALL OTHER METHODS TO CHANGE FORMATTING OF NOTES AND SPECIAL WORDS:
    
    Selection.HomeKey Unit:=wdStory 'go to start of document
    GUITAR_TAB__Notes_To_Bold
    
    Selection.HomeKey Unit:=wdStory 'go to start of document
    GUITAR_TAB__Special_Characters
    
    Selection.HomeKey Unit:=wdStory 'go to start of document
    GUITAR_TAB__Special_Words_To_Italics
    
    MsgBox ("Guitar tab formatting complete")
    
End Sub




'-----------------------------------------------------
Sub GUITAR_TAB__Notes_To_Bold()
'
' Finds all notes (as defined in array of strings) and makes them bold.
' NOTE: This is not a list of ALL possible notes - just the most common - you can
'       add more if you wish.
'

'## VARIABLES:
    
    Dim possNotesArr, possNotesArrLen
    Dim word, wordLen
    
    possNotesArr = Array( _
        "[", "]", _
        "A", "B", "C", "D", "E", "F", "G", _
        "Am", "Bm", "Cm", "Dm", "Em", "Fm", "Gm", _
        "A6", "B6", "C6", "D6", "E6", "F6", "G6", _
        "A7", "B7", "C7", "D7", "E7", "F7", "G7", _
        "Am7", "Bm7", "Cm7", "Dm7", "Em7", "Fm7", "Gm7", _
        "A9", "B9", "C9", "D9", "E9", "F9", "G9", _
        "Amaj7", "Bmaj7", "Cmaj7", "Dmaj7", "Emaj7", "Fmaj7", "Gmaj7", _
 _
        "Ab", "A#", "Bb", "C#", "Db", "D#", "Eb", "F#", "Gb", "G#", _
        "Abm", "A#m", "Bbm", "C#m", "Dbm", "D#m", "Ebm", "F#m", "Gbm", "G#m", _
        "Gsus4", "G6sus4", "Dsus2" _
        )
    
    possNotesArrLen = UBound(possNotesArr)
    
'## MAIN CODE:
    
    Do While WordBasic.AtEndOfDocument() = 0
        
        wordLen = Selection.EndOf(Unit:=wdWord, Extend:=wdExtend)
        word = Trim(Selection.Text)
        
        For j = 0 To possNotesArrLen
            If (word = possNotesArr(j)) Then
                Selection.Font.Bold = True
                Exit For
            End If
        Next j
        
        Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdMove
    Loop
    
End Sub

'-----------------------------------------------------
Sub GUITAR_TAB__Special_Characters()
'
' Finds special characters (including "[", "-", "#", etc)
' and changes their font/formatting as specified.
'

'## VARIABLES:
    
    Dim possNotesArr, possNotesArrLen
    Dim char
    
'## MAIN CODE:
    
    'Selection.HomeKey Unit:=wdStory 'go to start of document
    
    Do While WordBasic.AtEndOfDocument() = 0
        
        Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
        'wordLen = Selection.EndOf(Unit:=wdCharacter, Extend:=wdExtend)
        char = Selection.Text
        
        If (char = "[") Or (char = "]") Or (char = "#") Then
            Selection.Font.Bold = True
        ElseIf (char = "-") And (Selection.Style <> ActiveDocument.Styles("Heading 1")) Then
            Selection.Font.Color = wdColorGray25
        End If
        
        Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdMove
    Loop
    
End Sub

'-----------------------------------------------------
Sub GUITAR_TAB__Special_Words_To_Italics()
'
' Finds special words (including: "verse", "chorus", etc), makes them italic
' and converts them to uppercase (if not already).
'

'## VARIABLES:
    
    Dim wordArr, wordArrLen
    Dim word, wordLen
    
    wordArr = Array("VERSE", "CHORUS", "PRE", "PRECHORUS", "INTERLUDE", "BRIDGE", "INTRO", "OUTRO", "CHORDS")
    wordArrLen = UBound(wordArr)
    
'## MAIN CODE:
    
    Do While WordBasic.AtEndOfDocument() = 0
        
        wordLen = Selection.EndOf(Unit:=wdWord, Extend:=wdExtend)
        If (Selection.Characters.Last = " ") Then
            Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
        End If
        word = Selection.Text
        
        For i = 0 To wordArrLen
            If (StrComp(word, wordArr(i), vbTextCompare) = 0) Then  'StrComp is used to make sear case insensitive.
                Selection.Font.Italic = True
                Selection.Text = wordArr(i)
                Exit For
            End If
        Next i
        
        Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdMove
    Loop
    
End Sub











'-----------------------------------------------------
Sub GUITAR_TAB__Make_Note_Lines_Bold_Based_On_Spaces()
'
' Attempts to make notes bold, by counting the number of spaces
' on each line, and assuming that if there are more spaces than
' letters, then line is probably a line of notes.
'
    Dim line, lineLen, numSpaces, fractSpaces
    
    Do While WordBasic.AtEndOfDocument() = 0
        
        Selection.MoveRight Unit:=wdSentence, Count:=1, Extend:=wdExtend
        line = Selection.Text
        lineLen = Len(line)
        numSpaces = 0
        
        For i = 1 To lineLen
            If (Mid(line, i, 1) = " ") Then
                numSpaces = numSpaces + 1
            End If
        Next i
        
        fractSpaces = numSpaces / lineLen
        If (fractSpaces > 0.5) Then
            Selection.Font.Bold = True
        End If
        
        'MsgBox (numSpaces & " " & fractSpaces)
        
        Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdMove
    Loop
    
End Sub

'-----------------------------------------------------
Sub GUITAR_TAB__Between_Brackets_To_Bold()
'
' Makes everything between "[" and "]" pairs (inclusive) bold
'

    Dim beginFound
    beginFound = False

    Do While WordBasic.AtEndOfDocument() = 0
        
        If (beginFound = False) Then
            
            Selection.MoveRight Unit:=wdCharacter, Count:=1
            If Selection.Characters.First = "[" Then
                Selection.MoveRight Unit:=wdCharacter, Count:=2, Extend:=wdExtend
                beginFound = True
            End If
        
        Else
        
            Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
            If Selection.Characters.Last = "]" Then
                Selection.Font.Bold = True
                Selection.MoveRight Unit:=wdCharacter, Count:=1
                beginFound = False
            End If
        
        End If
    
    Loop
    
End Sub


'-----------------------------------------------------
Sub GUITAR_TAB__Notes_To_Bold__OLD_VERSION()
'
' More complex version of GUITAR_TAB__Notes_To_Bold, but more robust in the respect
' that normal "select to end of word" (Selection.EndOf(Unit:=wdWord, Extend:=wdExtend) )
' won't include characters like "#" & "[".
'

'DECLARE VARIABLES:
    
    Dim possNotesArr, possNotesArrLen
    Dim beginFound, word
        
    possNotesArr = Array( _
        "[", "]", _
        "A", "B", "C", "D", "E", "F", "G", _
        "Am", "Bm", "Cm", "Dm", "Em", "Fm", "Gm", _
        "A6", "B6", "C6", "D6", "E6", "F6", "G6", _
        "A7", "B7", "C7", "D7", "E7", "F7", "G7", _
        "Am7", "Bm7", "Cm7", "Dm7", "Em7", "Fm7", "Gm7", _
        "A9", "B9", "C9", "D9", "E9", "F9", "G9", _
        "Amaj7", "Bmaj7", "Cmaj7", "Dmaj7", "Emaj7", "Fmaj7", "Gmaj7", _
 _
        "Ab", "A#", "Bb", "C#", "Db", "D#", "Eb", "F#", "Gb", "G#", _
        "Abm", "A#m", "Bbm", "C#m", "Dbm", "D#m", "Ebm", "F#m", "Gbm", "G#m", _
        "Gsus4", "G6sus4", "Dsus2" _
        )
    
    possNotesArrLen = UBound(possNotesArr)
    beginFound = True
    
'MAIN:
    
    Do While WordBasic.AtEndOfDocument() = 0
        
        If (beginFound = False) Then
        
            'If (Selection.MoveRight <> 1) Then Exit For
            Selection.MoveRight Unit:=wdCharacter, Count:=1
            If (Selection.Characters.First = " ") Or (Selection.Characters.First = Chr(10)) Or (Selection.Characters.First = Chr(13)) Or (Selection.Characters.First = "/") Then
                Selection.MoveRight Unit:=wdCharacter, Count:=1
                beginFound = True
            End If
        
        Else
        
            Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
            If (Selection.Characters.Last = " ") Or (Selection.Characters.Last = Chr(10)) Or (Selection.Characters.Last = Chr(13)) Or (Selection.Characters.Last = "/") Then
                
                Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
                word = Selection.Text
                
                If (word = "") Or (word = " ") Then
                    Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
                Else
                    
                    '## CHECK WORD AGAINST ALL NOTES IN ARRAY:
                    For j = 0 To possNotesArrLen
                        If (word = possNotesArr(j)) Then
                            Selection.Font.Bold = True
                            Exit For
                        End If
                    Next j
                    
                End If
                beginFound = False
                
            End If
        
        End If
    
    Loop
    
End Sub

'-----------------------------------------------------
Sub GUITAR_TAB__Make_A_Unbold_If_Not_Note()
'
' Identifies "A" as not being a note if it's followed by a word
'

    Dim word, wordLen
    
    Do While WordBasic.AtEndOfDocument() = 0
        
        wordLen = Selection.EndOf(Unit:=wdWord, Extend:=wdExtend)
        
        If Selection.Characters.First = "A" Then
           
            word = Trim(Selection.Text)
            If (word = "A  ") Then
                Selection.Font.Bold = True
            Else
                Selection.Font.Bold = False
            End If
            
        End If
        
        Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdMove
    Loop
    
End Sub

'-----------------------------------------------------