View Single Post
 
Old 01-29-2018, 10:39 AM
kilroy kilroy is offline Windows 10 Office 2016
Competent Performer
 
Join Date: Sep 2016
Location: Southern Ontario
Posts: 118
kilroy is on a distinguished road
Default

Guitar, this is what I use for my sheet music. Not perfect but does a lot of the work. You can add more chords. I'm sure one of the guys could simplify it.

Code:
Sub ChangeColorTargets()
Dim range As range
Dim i As Long
Dim TargetList
 
TargetList = Array("A  ", "Am", "E7", "A#", "A7", "Ab", "B ", "Bm ", "B7", _
"C ", "Cm ", "D ", "Dm ", "E ", "Em ", " C", "C#", "Db", "D#", "E#", "Eb", "Fb", " F", "F#", "Gb", " G ", "G#", "Ab", "B#", "Bb")
'... Add additional words to this line at the end, each word to be separated with , "[WORD]"
' if you run out on the second line, end it with , "[WORD]" _ and continue on next line
 
For i = 0 To UBound(TargetList)
Set range = ActiveDocument.range
With range.Find
.Text = TargetList(i)
.Format = True
.MatchCase = True
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
Do While .Execute(Forward:=True) = True
range.Font.TextColor.RGB = RGB(0, 0, 255)
Loop
End With
Next
Call HighlightTargets
End Sub
Sub HighlightTargets()
Dim range As range
Dim i As Long
Dim TargetList
 
TargetList = Array("[Chorus]", "[Verse]", "[Bridge]", "[Solo]")
'... Add additional words to this line at the end, each word to be separated with , "[WORD]"
' if you run out on the second line, end it with , "[WORD]" _ and continue on next line
 
For i = 0 To UBound(TargetList)
Set range = ActiveDocument.range
With range.Find
.Text = TargetList(i)
.Format = True
.MatchCase = True
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
Do While .Execute(Forward:=True) = True
range.HighlightColorIndex = wdYellow
Loop
End With
Next
 
End Sub
Reply With Quote