Macro to set fill colors in a table

[Heather Mills]

I found a website with a table of RGB settings for a bunch of common
colors:

http://www.rose-hulman.edu/class/csse/csse351/www/RGBlist.html

I downloaded the table to a Word document, but the color samples in
the last column are all wrong. I converted a few by hand, but there
are dozens.

Would anyone care to take a crack at writing a macro that would set
the fill color in each cell of the last column to the RGB values in
columns 2-4?

 

[Harold Druss]

I found a website with a table of RGB settings for a bunch of common
colors:

http://www.rose-hulman.edu/class/csse/csse351/www/RGBlist.html

I downloaded the table to a Word document, but the color samples in
the last column are all wrong. I converted a few by hand, but there
are dozens.

Would anyone care to take a crack at writing a macro that would set
the fill color in each cell of the last column to the RGB values in
columns 2-4?

Hi Heather
This should do what you want.
==========================================================
Sub getrbgcolor()
Dim r As Long, g As Long, b As Long
Dim i As Long

On Error Resume Next

With ActiveDocument.Tables(1)
For i = 1 To .Rows.Count
r = Left(.Cell(i, 2).Range.Text, Len(.Cell(i, 2).Range.Text) - 2)
g = Left(.Cell(i, 3).Range.Text, Len(.Cell(i, 3).Range.Text) - 2)
b = Left(.Cell(i, 4).Range.Text, Len(.Cell(i, 4).Range.Text) - 2)
.Cell(i, 8).Shading.BackgroundPatternColor = RGB(r, g, b)
r = 255
g = 255
b = 255
Next
End With

MsgBox "finished"

End Sub
==========================================================
Good luck
Harold

 

[Heather Mills]

Hi Heather
This should do what you want.
==========================================================
Sub getrbgcolor()
Dim r As Long, g As Long, b As Long
Dim i As Long

On Error Resume Next

With ActiveDocument.Tables(1)
For i = 1 To .Rows.Count
r = Left(.Cell(i, 2).Range.Text, Len(.Cell(i, 2).Range.Text) - 2)
g = Left(.Cell(i, 3).Range.Text, Len(.Cell(i, 3).Range.Text) - 2)
b = Left(.Cell(i, 4).Range.Text, Len(.Cell(i, 4).Range.Text) - 2)
.Cell(i, 8).Shading.BackgroundPatternColor = RGB(r, g, b)
r = 255
g = 255
b = 255
Next
End With

MsgBox "finished"

End Sub
==========================================================
Good luck
Harold

Wow!!! That works like a charm. Thank you soooo much.

What would I have to do to have it only work on the table where the
cursor is? (If the cursor is not in a table, abort.)

That would allow me to build a little table with siome custom RGB
settings and see the results without having to wait for the whole list
to be regenerated.

 

[Heather Mills]

Hi Heather
This should do what you want.
==========================================================
Sub getrbgcolor()
Dim r As Long, g As Long, b As Long
Dim i As Long

On Error Resume Next

With ActiveDocument.Tables(1)
For i = 1 To .Rows.Count
r = Left(.Cell(i, 2).Range.Text, Len(.Cell(i, 2).Range.Text) - 2)
g = Left(.Cell(i, 3).Range.Text, Len(.Cell(i, 3).Range.Text) - 2)
b = Left(.Cell(i, 4).Range.Text, Len(.Cell(i, 4).Range.Text) - 2)
.Cell(i, 8).Shading.BackgroundPatternColor = RGB(r, g, b)

Why are the next three statements needed?