Random letter colors?
On Tue, 27 Dec 2005 08:35:22 +1300, "Peter in New Zealand"
peterbalplugATxtraSPOTcoSPOTnz wrote:
Every year I send out a Christmas newsletter to quite a lot of children
(grownup now, and grand children. I have established this as a family
tradition over several years, and they all seem to enjoy their Christmas
letter from Grandad. I use Word to compose it, with text and pictures, and
it's always been a heap of fun. Each sub heading has always been prepared
with alternative red and green letters, and looks real great in that
context. It's just for the kids, and only once a year, but something to do
it automatically would be a great labour saver to say the least.
Peter,
Way back in 2005, I asked how write a macro to automatically change
the colors of individual letters in some text. You asked for a copy of
the macro. It took me awhile to write it, and then I forgot that you
had asked. I just came across your post, so here's the macro.
I was going to have it allow the user to select the colors, but I
never got around to that. It's set for half red and half green. If you
want some other mix, you will need to edit the vaColors variable.
Maybe someone can suggest a way to allow the user to enter the colors
(eg, red, red, green).
Enjoy...
Option Explicit
'================================================= ========================================
' Macro: MyRandomCharColors
'
' Keyboard Shortcut: None
'
' Set each character in the selection to a different color
' 12/23/05 Basic macro posted to microsoft.public.word.newusers by Jay
Freedman, MVP
' He then continued to help me refine it.
'
' To Do:
' * Limit maximum consecutive in random order
'================================================= ========================================
Sub MyRandCharColors()
Const svTitle As String = "Random Character Colors Macro" 'Title for
MsgBox's etc.
Dim obChar As Range 'Object variable
Dim ilColorNext As Word.WdColorIndex 'Color Index property (long)
Dim ilColorLast As Long 'The last color that was applied
Dim vaColors As Variant 'Variant array to hold colors
Dim ilChar As Long 'Color index, if repeating;
counter if random
Dim svCharList As String 'The list of characters that
will be colored
Dim ilMaxChar As Long 'Max consecutive characters of
the same color (random or repeating)
Dim obForm As frmCharColors 'Object variable?
Set obForm = New frmCharColors 'Set up an instance?
ilMaxChar = 2 'Set the upper limit for consecutive characters of
the same color (2 is good)
'Define the list of colors to be used. Colors can be included more
than once.
vaColors = Array(wdRed, wdGreen, wdBlack) '3 colors
vaColors = Array(wdRed, wdGreen, wdBlue)
vaColors = Array(wdRed, wdRed, wdGreen) 'Red:green = 2:1
vaColors = Array(wdRed, wdGreen) 'Christmas colors
'Define which characters will be colored. All others will be skipped
(colored black).
'This range includes all of the letters, numbers, and specials below
Ascii 127.
'They all lie between the space (hex 20) and the ~ (hex 7E):
svCharList = "[ -~]"
'If we want to exclude the space, we need to start at the next
character, but that
'is the "!" which is the exclusion character, so we need to start with
the next
'character, the ", and add the "!" at the end:
svCharList = "[""-~!]"
'The curly (smart) quotes are at Ascii 145-149. We can either build a
range using the
'chr$() function:
svCharList = "[""-~!" & Chr$(145) & "-" & Chr$(148) & "]"
'or paste the characters from Word or the Immediate window.
svCharList = "[""-~!‘-”]"
'Put up a userform to find out if the user wants random or repeating
colors
obForm.Tag = "Cancel" 'Set it to cancel by default
obForm.Show 'Put up the form and get the selection into
me.tag
If obForm.Tag "Random" And obForm.Tag "Repeat" Then GoTo ExitSub
'If not a choice, quit
If obForm.txtRandMax "" Then
ilMaxChar = obForm.txtRandMax
End If
'Apply the colors
ilChar = 0 'Start with the 1st color or zero the counter
ilColorLast = -1 'Initialize to a color that can't match the next one
Randomize 'Just in case they select the Random option
For Each obChar In Selection.Characters
'First, check if it's a character to be colored. Then figure out how
(random or repeating).
If obChar.Text Like svCharList Then 'If it's a character to be
colored,
Select Case obForm.Tag 'Use whichever method
the user choose
Case "Repeat" 'If they chose
'repeat',
ilColorNext = MyRandCharColorsRepeat(ilChar, vaColors)
Case "Random" 'If they chose
'random',
ilColorNext = MyRandCharColorsRandom(ilChar, vaColors,
ilMaxChar, ilColorLast)
End Select
ilColorLast = ilColorNext 'Save the color to check
against next character
Else 'If it is, color it as
requested
ilColorNext = vbBlack 'Make it black
End If
obChar.Font.ColorIndex = ilColorNext
Next obChar
ExitSub: 'We're done. Unload the form and exit
Unload obForm
Set obForm = Nothing
End Sub
'Called by MyRandCharColorsRepeat
'Select a random color from the list up to the consecutive limit
Function MyRandCharColorsRandom(ByRef ilChar As Long, ByVal vaColors
As Variant, _
ByVal ilMaxChar As Long, ByVal
ilColorLast As Long) As Long
Dim nsRnd As Single 'Random color index
Do 'Select a random color up to
the consecutive limit
nsRnd = Rnd()
MyRandCharColorsRandom = vaColors(Int((UBound(vaColors) + 1) *
nsRnd)) 'Select a random color
If MyRandCharColorsRandom ilColorLast Then 'If it's a new
color, use it
ilChar = 1 'Reset the
counter & go
Exit Do
Else 'If it's the same
color,
ilChar = ilChar + 1 'Count it
If ilChar = ilMaxChar Then Exit Do 'If not too
many, go use it
End If 'Else, go get
another color
Loop
End Function
'Called by MyRandCharColorsRepeat
'Select the next color in the list, wrapping around to the start
Function MyRandCharColorsRepeat(ByRef ilChar As Long, ByVal vaColors
As Variant) As Long
MyRandCharColorsRepeat = vaColors(ilChar Mod (UBound(vaColors) + 1))
ilChar = ilChar + 1
End Function
--
Running Word 2000 SP-3 on Windows 2000
|