The Word Crayon

A Little Background
Once every year or so a piece of e-mail arrives asking for some way to create a macro which "…gets Word to search a document for the word [XXXX] and change its color to Red…" . And at those times, I usually sit back for a few minutes and think to myself that it's a reasonable request...see no obvious approach to the problem...and forget about it until next year. After all, it's no problem to do this with Word's Replace tool available to you directly from the Edit menu. It's easy!

Well there are some other real reasons to decide not to build a tool to do this job in Word, too. For instance, using the Find tool through VBA is usually pretty clunky and sometimes involves some very strenuous gyrations. Also, if there are a number of special words, phrases or character combinations you want to treat, where do you want to store the list of special words and the colors to apply? If you misuse the registry (yes, this would be an intense misuse of the registry) for this purpose, you also have to provide an interface in order to add these values.

And, finally, the fact is that the Office Development team has been extremely inconsistent in its management of Word's built-in color constants from one version to the next. As if that weren't bad enough, some of the values returned by browsing the Word object model return a Value out of range error when you attempt to use them.

See, it all just looks like a lot of work for no really strong reason…except the question keeps landing in the old Inbox. Now I feel guilty for not ever developing a usable answer in the past.

A Strategy for the Wicked Crayon
Whenever a problem looks too big to me, I try to remember something a friend of mine told me once; "Every problem is a collection of smaller, simpler problems. Solve each of those problems one at a time and the big problem solves itself."

I believe Mr. Walker (http://www.nvdi.com) was explaining the fundamental method behind any engineering discipline; and what is programming, but an exercise in engineering (problem solving)?

Broken down into the simplest elements, the solution for this Word as Coloring Book problem consists of solving these problems:

1. Supply an easily edited, easily stored and user specific settings file in which a user may store the special words and color associations, i.e., Greg=wdColorBlue
   
   
2. Identify the real values used by word for each of its color constants and (I hate whenever I have to kludge something in this way) use them rather than the constant name. Ick!
   
   
3. Work with Word's Find object and the Replace Object until we have a reasonable, reliable method of working with them.
   
   
4. To ease our lives, limit the scope of compatibility to Word 2000 and 2002. I just know you'll be running out to buy your upgrade immediately, right?

Before we go any farther, you should open a new document, save it as WordCrayon.dot, press Alt/F11 (to open the Visual Basic Editor [VBE]) and insert a new code module in your new document (highlight the new document in the Project Files dialog in the VBE, click Insert/Module). As we go along, copy the code in this article and then paste it into this code module. Be sure to press Ctrl/S every now and then to save your work!

Note! A downloadable zip file is included, if you don't want to go through the motions of learning to create your own code module. For non-programmers, you can go to the bottom of this article where you'll find instructions for using the Word Crayon macro.

Storing and Retrieving the User's Color Scheme
First, an admission (or admonition, depending on how you read data)—I like scripting and I do a lot of work with the FileSystemObject (FSO). It's strong and it's fast. Some claim that the FSO is inefficient and base that claim solely upon an excellent example provided by Karl Peterson, Microsoft VB MVP, at http://www.mvps.org/vbnet/index.html?code/fileapi/fsoapicompare.htm. However, Karl's example is built on the normally valid assumption that a single comparison tells the whole story (actually, he's pretty careful to lead his comparison with that it's "…about performing file searches in a specific folder."

The fact is that most of what we need the FSO for has nothing to do with its performance at parsing a directory's contents. What we need it for is all the other things it does very efficiently, like reading and building text files, copying files and determining if they actually exist. The normal mechanisms employed within VB(A) or the use of API calls is completely unnecessary for the job in this example template, too.

Since I already have a working set of tools for the job of creating a settings file and storing a simple list of items then reading that list back based on the FSO and written as VBScripts, we'll use them here. We'll sacrifice only two things—we'll go ahead and use a couple of Global variables (not really necessary here, but it's a concession to simply copying and pasting VBScript to a VBA application), one of which will point to WScript's Shell object, and we'll use Late Binding for those two variables. This should help us forestall a problem in the future as object references get updated.

Here's the first bit of code:

'===================================================
Public objFSO As Object
Public objShell As Object
'===================================================
Sub GetStartedColoring()

Dim strMyDocuments 
Dim arrKeyWords As Variant
Dim arrSplit As Variant
Dim i As Long

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("WScript.Shell")
strMyDocuments = objShell.SpecialFolders("MyDocuments")

If Right(strMyDocuments, 1) <> "\" Then
    strMyDocuments = strMyDocuments & "\"
End If

If objFSO.FileExists(strMyDocuments & "ColorKeyWords.txt") Then
    arrKeyWords = InitFile(strMyDocuments & _
    "ColorKeyWords.txt", ";")

    For i = 0 To UBound(arrKeyWords)
        If arrKeyWords(i) <> "" Then
            arrSplit = Split(arrKeyWords(i), "=")
            HexValue = ConstConversion(Trim(arrSplit(1)))
            ColorWords Trim(arrSplit(0)), HexValue
        End If
    Next i

    Selection.HomeKey Unit:=wdStory, Extend:=False
Else
    MsgBox "Could not find " & _
    strMyDocuments & "ColorKeyWords.txt . Exiting Macro."
End If

End Sub
'===================================================
Function InitFile(HostSource, strComment)

'********************************************************
'Constants for file operations                         '*
'********************************************************
Const ForReading = 1, ForWriting = 2, ForAppending = 8 '*
'********************************************************


Dim ts
Dim tsLine
Dim arrWords As Variant
Dim strTrim As String
 
On Error Resume Next

ReDim arrWords(0)

Set ts = objFSO.OpenTextFile(HostSource, ForReading, False)
Do While Not ts.AtEndOfStream
    tsLine = Trim(ts.ReadLine)
    tsLine = tsLine
    If tsLine <> "" And Left(tsLine, 1) <> strComment Then
        strTrim = Trim(tsLine)
        lngBoundary = UBound(arrWords)
        If arrWords(lngBoundary) = "" Then
            arrWords(lngBoundary) = strTrim
        Else
            ReDim Preserve arrWords(lngBoundary + 1)
            arrWords(lngBoundary + 1) = strTrim
        End If
    End If
Loop
ts.Close

InitFile = arrWords

On Error GoTo 0

End Function
'===================================================

Since we're using Late Binding instead of setting references to WScript and the FileSystemObject, the variables objFSO and objShell are declared as Object Variables. You don't really have to explicitly declare their type, but failing to do so leads to some inefficiency. There was once a time when this omission would have a serious performance impact but those days are largely gone due to the advances in hardware since these methods first appeared. It's still recommended that you program for efficiency though and that means formally declaring a variable's type whenever possible.

Once we have a reference to the FileSystemObject and WScript's shell object, we use them to determine the currently logged on user's My Documents folder. Then we look in that location for a file called ColorKeyWords.txt. If it exists, we pass it to the InitFile function. If it doesn't exist, use Notepad to create it. For our purposes here's a list of the valid color values and some characters set equal to that color. Just paste them into your ColorKeyWords.txt text file and save it:

a=wdColorAqua
b=wdColorAutomatic
c=wdColorBlack
d=wdColorBlue
e=wdColorBlueGray
f=wdColorBrightGreen
g=wdColorBrown
h=wdColorDarkBlue
i=wdColorDarkGreen
j=wdColorDarkRed
k=wdColorDarkTeal
l=wdColorDarkYellow
m=wdColorGold
n=wdColorGray05
o=wdColorGray10
p=wdColorGray125
q=wdColorGray15
r=wdColorGray20
s=wdColorGray25
t=wdColorGray30
u=wdColorGray35
v=wdColorGray375
w=wdColorGray40
x=wdColorGray45
y=wdColorGray50
z=wdColorGray55
aa=wdColorGray60
bb=wdColorGray625
cc=wdColorGray65
dd=wdColorGray70
ee=wdColorGray75
ff=wdColorGray80
gg=wdColorGray85
hh=wdColorGray875
ii=wdColorGray90
jj=wdColorGray95
kk=wdColorGreen
ll=wdColorIndigo
mm=wdColorLavender
nn=wdColorLightBlue
oo=wdColorLightGreen
pp=wdColorLightOrange
qq=wdColorLightturquoise
rr=wdColorLightYellow
ss=wdColorLime
tt=wdColorOliveGreen
uu=wdColorOrange
vv=wdColorPaleBlue
ww=wdColorPink
xx=wdColorPlum
yy=wdColorred
zz=wdColorrose
aaa=wdColorSeaGreen
bbb=wdColorSkyBlue
ccc=wdColorTan
ddd=wdColorTeal
eee=wdColorTurquoise
fff=wdColorViolet
ggg=wdColorWhite
hhh==wdColorYellow

We also pass along the semi-colon (;) so that InitFile knows to ignore any line in the file that begins with a semi-colon. Any such line is a comment line and it allows you to write things in the file that will remain ignored by our macro. You may want to leave yourself a note in the file or you may want to disable special coloring for the name "Joe Schmuckatelli" this time around. Simply placing a semi-colon in front of those lines in the text file will allow you to do this without impacting the macro's operation in a bad way.

The IntiFile function reads the entire file and for every non-comment line in the file, and creates a new element in a dynamic array. The array grows a line at a time until there are no new entries to add to it. When the file has been read and closed, the IntiFile function's value is set to be that of the dynamic array.

That result is passed back to the GetStartedColoring subroutine. GetStartedColoring now parses the array one element at a time. Since we already stated that each value would be our word, an equal sign (=) and a color (using the actual Word constant name), we now need to identify what words and what color those words should be. To do this, GetStartedColoring takes the first value in the array and uses the Split function to separate our word from its desired color. We use the equal sign to tell the Split function what character to use it as the separator. In turn, each of the array values will be:

• Identified and split into Word/Character/Phrase to be searched for and the color to apply.
  
  
• The proper value for that array item's desired color.
  
  
• The Word/Character/Phrase will be searched for within the current active document and it will be replaced by the same word of the proper color.

There is one weakness that should pop out glaringly in this example, then. If it's an equal sign that you want to find and change to another color, well, you're not going to use this code to successfully do the job. Obviously, there are ways around this issue, but I'll leave it to your imagination to figure it out for yourself. How else will you learn, eh?

Correcting the Inconstant Word Color Constants
What a mess!! This particular routine wouldn't have to exist if the Word Object Model had been updated consistently here. But it wasn't and the only way I know of working around it is the laborious browsing of the Hex values for each of the 60 or so color constants Word 2000/2002 uses. In some cases, the Hex values returned by the Object Model are flat-out incorrect and the Integer converted value must be used. To save you from wasting time, you need this conversion routine and our macro will use it to determine exactly what is meant by wdColorBlue.

Not much explanation is needed here. Simply copy, paste and take a couple aspirin:

'===================================================
Function ConstConversion(ByVal strColor As String)

Select Case strColor

Case "wdColorAqua"
    ConstConversion = &HCCCC33
Case "wdColorAutomatic"
    ConstConversion = &HFF000000
Case "wdColorBlack"
    ConstConversion = 0
Case "wdColorBlue"
    ConstConversion = &HFF0000
Case "wdColorBlueGray"
    ConstConversion = &H996666
Case "wdColorBrightGreen"
    ConstConversion = 65280
Case "wdColorBrown"
    ConstConversion = &H3399
Case "wdColorDarkBlue"
    ConstConversion = &H800000
Case "wdColorDarkGreen"
    ConstConversion = &H3300
Case "wdColorDarkRed"
    ConstConversion = &H80
Case "wdColorDarkTeal"
    ConstConversion = &H663300
Case "wdColorDarkYellow"
    ConstConversion = 32896
Case "wdColorGold"
    ConstConversion = 52479
Case "wdColorGray05"
    ConstConversion = &HF3F3F3
Case "wdColorGray10"
    ConstConversion = &HE6E6E6
Case "wdColorGray125"
    ConstConversion = &HE0E0E0
Case "wdColorGray15"
    ConstConversion = &HD9D9D9
Case "wdColorGray20"
    ConstConversion = &HCCCCCC
Case "wdColorGray25"
    ConstConversion = &HC0C0C0
Case "wdColorGray30"
    ConstConversion = &HB3B3B3
Case "wdColorGray35"
    ConstConversion = &HA6A6A6
Case "wdColorGray375"
    ConstConversion = &HA0A0A0
Case "wdColorGray40"
    ConstConversion = &H999999
Case "wdColorGray45"
    ConstConversion = &H8C8C8C
Case "wdColorGray50"
    ConstConversion = &H808080
Case "wdColorGray55"
    ConstConversion = &H737373
Case "wdColorGray60"
    ConstConversion = &H666666
Case "wdColorGray625"
    ConstConversion = &H606060
Case "wdColorGray65"
    ConstConversion = &H656565
Case "wdColorGray70"
    ConstConversion = &H4C4C4C
Case "wdColorGray75"
    ConstConversion = &H404040
Case "wdColorGray80"
    ConstConversion = &H333333
Case "wdColorGray85"
    ConstConversion = &H262626
Case "wdColorGray875"
    ConstConversion = &H202020
Case "wdColorGray90"
    ConstConversion = &H191919
Case "wdColorGray95"
    ConstConversion = 789516
Case "wdColorGreen"
    ConstConversion = 32768
Case "wdColorIndigo"
    ConstConversion = &H993333
Case "wdColorLavender"
    ConstConversion = &HFF99CC
Case "wdColorLightBlue"
    ConstConversion = &HFF6633
Case "wdColorLightGreen"
    ConstConversion = &HCCFFCC
Case "wdColorLightOrange"
    ConstConversion = 39423
Case "wdColorLightTurquoise"
    ConstConversion = &HFFFFCC
Case "wdColorLightYellow"
    ConstConversion = &H99FFFF
Case "wdColorLime"
    ConstConversion = 52377
Case "wdColorOliveGreen"
    ConstConversion = 13107
Case "wdColorOrange"
    ConstConversion = 26367
Case "wdColorPaleBlue"
    ConstConversion = &HFFCC99
Case "wdColorPink"
    ConstConversion = &HFF00FF
Case "wdColorPlum"
    ConstConversion = 6697881
Case "wdColorRed"
    ConstConversion = 255
Case "wdColorRose"
    ConstConversion = &HCC99FF
Case "wdColorSeaGreen"
    ConstConversion = &H669933
Case "wdColorSkyBlue"
    ConstConversion = &HFFCC00
Case "wdColorTan"
    ConstConversion = &H99CCFF
Case "wdColorTeal"
    ConstConversion = &H808000
Case "wdColorTurquoise"
    ConstConversion = &HFFFF00
Case "wdColorViolet"
    ConstConversion = &H800080
Case "wdColorWhite"
    ConstConversion = &HFFFFFF
Case "wdColorYellow"
    ConstConversion = 65535
Case Else
    ConstConversion = 0
End Select

End Function
'===================================================


'===================================================
Sub ColorWords(ByVal strText As String, _
ByVal MyColor As Variant)

With ActiveDocument.Content.Find
    .ClearFormatting
    With .Replacement
        .ClearFormatting
        .Font.Color = MyColor
    End With
    .Execute FindText:=strText, ReplaceWith:=strText, _
    Format:=True, Replace:=wdReplaceAll

End With

End Sub
'===================================================

The basic idea behind this routine is simple. With all the content in the active document, use the Find object to take the phrase we sent it (strText) and replace it with that same text, only this time we'll color it with whatever value we passed (strColor). What's so glamorous about this routine? The Replacement Object. Without this object, searching and replacing in Word VBA is a complete pain in the rump. My old routines, created before I learned of the Replacement Object, involved what appeared to be two complicated instances of the Find object and a recursion routine straight out of hell that operated solely by the good graces of Selection.Find.Found. You really don't want me to demonstrate that method to you. It's ugly and, as far as I can tell, the only other way to do the job.

Well Said, But Now Let's See About Well Done!
The job isn't done until you've cleaned up, right? In our case, we need proof that all is fine and here's a simple test; we'll make a ransom note! The test couldn't be simpler. Just take the contents of your ColorKeyWords.txt file and paste them into a blank document as sample text. Go to the Tools menu, click on Macros and choose the macro called GetStartedColoring. If all goes well, that formerly bland list of characters and colors will be applied to the list.

No, we didn't get the big box of 64 colors, but Word comes reasonably close at 60 recognized colors (if you include the Automatic color as a possible value)!

Conclusive Color
We actually accomplished several things with this example. First, we adhered to the most basic engineering principle by breaking our big problem down into smaller ones. Then we attacked the slop in Word by getting the real, usable values it uses for coloring text. We adhered to our compatibility goal and came up with a fairly nice, elegant way to apply the right color to the right characters within any document.

Is there room for improvement? Absolutely!! Here are some things you might consider doing on your own to improve this code:

• Account for words in Fields
  
• Check and improve operations if one of your keywords is in a table
  
• Manage the ScreenUpdating and ScreenRefresh settings to improve speed
• Convert the routines to Early Binding
• Reorganize the code so that the use of Global Variables isn't necessary
• Account for the possibility of needing to set the color on an equal sign

If you do improve on the code, we'd love you to write an article to share your code and explanations with all our readers!

And, of course, next year someone will come along and ask if there's any way to create a macro to color only certain words in a document. We're ready for them now!

For Non-Programmers!
If you'd like to use the GetStartedColoring macro, but don't have a programmer's background, here's a set of simple steps to use the download file:

• Download the ColoringWord.zip file
• Unzip the file and pay attention to where the two files are saved
• Move the ColorKeyWords.txt file into your My Documents folder and leave it there
• Move the ColorCodingDemo.dot file into your ...word/startup directory so the macro is available to you as an add-in...OR...
• Open the ColorCodingDemo.dot file and click Tools/Macro/Macro/Organizer to copy the GetStartedColoring macro to your Normal.dot template

To use the Word Crayon:

• Use the ColorKeyWords.txt as a color guide. In fact, you might want to rename it to something like ColorKeyWordsGuide.txt to keep all the color codes handy, but safe. Also, be sure to comment the existing lines in the file using a semi-colon. Don't delete them since those lines are also a handy guide for the colornames that will work with this macro..
• Click Start/Run/Notepad and create a new ColorKeyWords.txt file and save it to your My Documents folder—this is the text file you'll use to search out the words and add the color you want.
• Example: When you want to color specific words in a Word document, add the word with color value into this ColorKeyWords.txt file, such as:
  • Greg=wdColorBlue
  • Dian=wdColorBrightGreen
    ...and so on, giving each word a color value
• Then run the GetStartedColoring macro. It will use the ColorKeyWords.txt as a reference to know which words should be searched out and what color they should become.
• To run the macro against another document, with different words and different colors, just modify the ColorKeyWords.txt text file before you run the macro again against the new document.