Colouring Table Cells

[Peter Rooney]

re my previous posting on creating a table and colouring the cells in:

Is there any way to use RGB colour sequences to colour in a cell in a table?

I've already used things like:

CellToColour.Shading.BackgroundPatternColorIndex = wdWhite

but this "wd" range of colours is a bit limiting for what i want to do!

Thanks in advance

pete

 

[Helmut Weber]

Hi Peter,

With Selection.Cells.Shading
.BackgroundPatternColor = RGB(100, 100, 100)
End With

I think in Version higher then 97.

Greetings from Bavaria, Germany
Helmut Weber, MVP
"red.sys" & chr(64) & "t-online.de"
Word 2002, Windows 2000

 

[Greg]

Peter,

For you checkerboard question, you might try:

Sub ScratchMacro()
Dim i As Integer

Selection.Tables(1).Cell(1, 1).Shading.BackgroundPatternColorIndex =
wdBlack
RowPainter
For i = 1 To Selection.Tables(1).Rows.Count - 1
Selection.MoveRight Unit:=wdCell, Count:=1, Extend:=wdMove
If Selection.Cells(1).Previous.Shading.BackgroundPatternColorIndex =
wdBlack Then
Selection.Cells(1).Shading.BackgroundPatternColorIndex = wdBlack
Else
Selection.Cells(1).Shading.BackgroundPatternColorIndex = wdRed
End If
RowPainter
Next
End Sub
Sub RowPainter()
Dim j As Integer
For j = 1 To Selection.Tables(1).Columns.Count - 1
Selection.MoveRight Unit:=wdCell, Count:=1, Extend:=wdMove
If Selection.Cells(1).Previous.Shading.BackgroundPatternColorIndex =
wdBlack Then
Selection.Cells(1).Shading.BackgroundPatternColorIndex = wdRed
Else
Selection.Cells(1).Shading.BackgroundPatternColorIndex = wdBlack
End If
Next
End Sub

 

[Peter Rooney]

Helmut,

This is exactly what i wanted - it was swapping .backgroundpatterncolorindex
for .backgroundpatterncolor that had me stumped!

Thanks a lot!

Pete

 

[Greg]

Pete,

My first suggestion worked only for a grid with an even number of
columns (an 8x8 checkerboard). I realized that it didn't work for a
grid with an odd number of columns. Here is modified code that works
on both.

Sub ScratchMacro()
Dim i As Integer
Dim oLayOut As Integer

oLayOut = Selection.Tables(1).Columns.Count Mod 2
If Not Selection.Information(wdWithInTable) Then
MsgBox ("Select a table before running this macro")
Exit Sub
Else
Selection.Tables(1).Cell(1, 1).Shading.BackgroundPatternColorIndex =
wdBlack
RowPainter
For i = 1 To Selection.Tables(1).Rows.Count - 1
Selection.MoveRight Unit:=wdCell, Count:=1, Extend:=wdMove
If oLayOut = 0 Then
If
Selection.Cells(1).Previous.Shading.BackgroundPatternColorIndex =
wdBlack Then
Selection.Cells(1).Shading.BackgroundPatternColorIndex =
wdBlack
Else
Selection.Cells(1).Shading.BackgroundPatternColorIndex =
wdYellow
End If
Else
If
Selection.Cells(1).Previous.Shading.BackgroundPatternColorIndex =
wdBlack Then
Selection.Cells(1).Shading.BackgroundPatternColorIndex =
wdYellow
Else
Selection.Cells(1).Shading.BackgroundPatternColorIndex =
wdBlack
End If
End If
RowPainter
Next
End If
End Sub
Sub RowPainter()
Dim j As Integer
For j = 1 To Selection.Tables(1).Columns.Count - 1
Selection.MoveRight Unit:=wdCell, Count:=1, Extend:=wdMove
If Selection.Cells(1).Previous.Shading.BackgroundPatternColorIndex =
wdBlack Then
Selection.Cells(1).Shading.BackgroundPatternColorIndex = wdYellow
Else
Selection.Cells(1).Shading.BackgroundPatternColorIndex = wdBlack
End If
Next
End Sub

 

[Peter Rooney]

Greg,

I just copied this across and it works fine. I particularly liiked the bit
of code that ensures you've clicked on a table before the macro runs!

Thank you very much!

Pete

 

[Greg]

Peter,

Glad to help.
Jonathan West will tell us that if it "works fine" then it is probably
good enough. However, if anyone has a simplified approach I would be
interested.

 

[Martin Seelhofer]

Hey there

However, if anyone has a simplified approach I would be interested.

Since you asked, here's one ;-)
(for a commented version, see bottom of posting)

' checks if selection is inside a table and stops if not
Sub formatTableAsCheckerBoard()
If Not Selection.Information(wdWithInTable) Then
MsgBox "Select a table before running this macro"
Exit Sub
End If

Call formatColouredTable(Array(wdBlack, wdWhite))
End Sub

' formats the selected table according to the given colors
Sub formatColouredTable(colors As Variant)
Dim acCell As Cell
Dim numColors As Long
Dim i As Long
If Not IsArray(colors) Then Exit Sub

numColors = UBound(colors) - LBound(colors) + 1
i = 0
For Each acCell In Selection.Tables(1).Range.Cells
acCell.Shading.BackgroundPatternColorIndex = _
colors(i Mod numColors)
i = i + 1
Next
End Sub

' Resets the background of the selected table
Sub ResetTableBG()
Dim acCell As Cell
For Each acCell In Selection.Tables(1).Range.Cells
acCell.Shading.BackgroundPatternColorIndex = wdNone
Next
End Sub


Note that with such a generalized solution, you can
easily apply other coloring patterns, like e.g. Red, White, Blue:

Call formatColouredTable(Array(wdRed, wdWhite, wdBlue))



Cheers,
Martin



---------------------------------------
' commented version:

' checks if selection is inside a table and stops if not
Sub formatColouredTable(colors As Variant)
Dim acCell As Cell
Dim numColors As Long
Dim i As Long
' only run this sub if an array was given
If Not IsArray(colors) Then Exit Sub

numColors = UBound(colors) - LBound(colors) + 1
i = 0
For Each acCell In Selection.Tables(1).Range.Cells
' use the colours of the given array one after
' the other (achieved through the use of the
' modulo operator)
' NOTE: this works also for more colors than
' just 2
acCell.Shading.BackgroundPatternColorIndex = _
colors(i Mod numColors)
i = i + 1
Next
End Sub

' formats the selected table according to the given colors
Sub formatTableAsCheckerBoard()
' check if a table was selected
If Not Selection.Information(wdWithInTable) Then
' No? --> inform user and stop
MsgBox "Select a table before running this macro"
Exit Sub
End If

' format the selected table using a Black and White
' (checkerboard) pattern
Call formatColouredTable(Array(wdBlack, wdWhite))
End Sub

' Resets the background of the selected table
Sub ResetTableBG()
Dim acCell As Cell
For Each acCell In Selection.Tables(1).Range.Cells
acCell.Shading.BackgroundPatternColorIndex = wdNone
Next
End Sub

 

[Martin Seelhofer]

Hey there again

One more optimization:

' Resets the background of the selected table
Sub ResetTableBG()
Dim acCell As Cell
For Each acCell In Selection.Tables(1).Range.Cells
acCell.Shading.BackgroundPatternColorIndex = wdNone
Next
End Sub

Thanx to the generalized sub formatColouredTable, this
may simply be written as:

Sub ResetTableBG()
Call formatColouredTable(Array(wdNone))
End Sub


Cheers,
Martin

 

[Greg]

Martin,

Very interesting. Thank you.

 

[Greg]

Martin,

While your code is sweet, on closer examination it has the same problem
as my first stab. That is if the number of columns is a multiple of
the number of colors then the cell coloring won't be staggered e.g.,
and 8X8 tables is not checkered when using two colors. It produces a
column of balck then a column of read etc.

 

[Martin Seelhofer]

Hey Greg

While your code is sweet, on closer examination it has the same problem
as my first stab. That is if the number of columns is a multiple of
the number of colors then the cell coloring won't be staggered e.g.,
and 8X8 tables is not checkered when using two colors. It produces a
column of balck then a column of read etc.

Sorry 'bout that. I figure that's what happens when you hack some
lines of code *before* thinking long enough about the actual problem :-/

However, here's a fixed version (commented) with just a couple of
new code lines (and a slightly changed structure --> with...). Should
now work correctly:

Sub formatColouredTable(colors As Variant)
Dim acCell As Cell
Dim numColors As Long
Dim i As Long
Dim isEvenTable As Boolean
' only run this sub if an array was given
If Not IsArray(colors) Then Exit Sub

With Selection.Tables(1)
' save this for later use: does the table have
' a column-count which is a multiple of the
' given number of colors?
numColors = UBound(colors) - LBound(colors) + 1
isEvenTable = (.Columns.Count Mod numColors) = 0
i = 0
For Each acCell In .Range.Cells
' use the colours of the given array one after
' the other (achieved through the use of the
' modulo operator)
' NOTE: this works also for more colors than
' just 2
acCell.Shading.BackgroundPatternColorIndex = _
colors(i Mod numColors)
i = i + 1
' additionally, increase by 1 if we are at the
' last column of a table with column-count which
' is a multiple of the given number of colors
If acCell.ColumnIndex = .Columns.Count And _
isEvenTable Then
i = i + 1
End If
Next
End With
End Sub



Cheers,
Martin

 

[Greg Maxey]

Martin,

That nailed it.

 

[Peter Rooney]

Wow.

I opened up a real discussion here!

I came up with a solution with everyone's help, but I don't hink I'll bother
posting it up now )) - perhaps you can all help me with the "Stripey Table"
post elsewhere!

Cheers

Pete