View Single Post
 
Old 01-03-2013, 09:55 AM
Jennifer Murphy's Avatar
Jennifer Murphy Jennifer Murphy is offline Windows XP Office 2007
Competent Performer
 
Join Date: Aug 2011
Location: Silicon Valley
Posts: 234
Jennifer Murphy is on a distinguished road
Default

Using the help from this thread, I added a new feature to my random color macro. The code snippet below will assign a random color from the entire color palette (16M colors) to each character in the selection. The result is kinda cool.

Code:
Sub MyRandCharColors()
Dim oChr As Range
Dim lngR As Long, lngG As Long, lngB As Long
Randomize
For Each oChr In Selection.Characters
  lngR = Rnd() * 256
  lngG = Rnd() * 256
  lngB = Rnd() * 256
  oChr.Font.Color = RGB(lngR, lngG, lngB)
Next oChr
End Sub
Replacing the last statement with this one will assign each letter a random shade of grey. Not sure it's useful.

Code:
oChr.Font.Color = RGB(lngR, lngR, lngR)  '256 shades of grey
I do have some questions:

Should the Rnd() factor be 256 or 255? Rnd() returns a number on [0,1). That is, including 0, but not 1. If I use 255, I'll never get a 255 color value. Right?

Should I convert lngR et al to integers (int(lngR))? It seems to work as is.

Some of the colors this macro produces are too light. The next snippet makes an adjustment if the sum of the color values exceed some threshold. This seems to work pretty well.

Code:
Sub MyRandCharColors()
Dim oChr As Range
Dim lngR As Long, lngG As Long, lngB As Long
Dim lngRGBSum As Long, lngRGBF As Long
Const lngRGBMax As Long = 500
Randomize
For Each oChr In Selection.Characters
  lngR = Rnd() * 256
  lngG = Rnd() * 256
  lngB = Rnd() * 256
  lngRGBSum = lngR + lngG + lngB
  If lngRGBSum > lngRGBMax Then     'If sum > max, scale it down to max
    lngRGBF = lngRGBMax / lngRGBSum
    lngR = lngR * lngRGBF
    lngG = lngG * lngRGBF
    lngB = lngB * lngRGBF
  End If
  oChr.Font.Color = RGB(lngR, lngG, lngB)
Next oChr
End Sub
Any comments or suggestions?
Reply With Quote