Stripey Tables

Thread view:

Enable EMail Alerts

Start New Thread

Thread rating:

Peter Rooney - 10 Mar 2005 10:29 GMT

Good morning, all!

Following on from the success of my checkerboard table yesterday (thanks to
all who helped!), I now want to do something that I thought would be simpler,
but in fact has turned out to be more problematical.

I now want to colour alternate columns in the table in one of two different
colours, to produce a striped effect.

However, when I get to the indicated line in the code below, I get "Object
doesn't support this property or method" I'm sure this should be quite easy
to get around - I would have thought that each member of a column would be a
cell, but I'm obviously wrong - can anybody help me out with the correct
syntax, please?

Thanks in advance

Pete

Sub VStripeGrid()

SetRGBColours ' Subroutine to set RGB sequences to colour variable names
GridReset ' Subroutine to sets all cells back to white

FirstForegroundColour = Black
FirstBackgroundColour = Custom1
FirstTexture = wdTextureNone
SecondForegroundColour = Black
SecondBackgroundColour = Custom2
SecondTexture = wdTextureNone

'Set ThisTable = ActiveDocument.Tables(1)

If Not Selection.Information(wdWithInTable) Then
MsgBox ("Select a table before running this macro")
Exit Sub
End If

Set ThisTable = Selection.Tables(1)
ColumnCount = ThisTable.Columns.Count
RowCount = ThisTable.Rows.Count
'MsgBox (RowCount & " rows by " & ColumnCount & " columns")
SetRGBColours
For ColumnCounter = 1 To ColumnCount
If ColumnCounter Mod 2 = 1 Then 'odd numbered column
MsgBox ("Column " & ColumnCounter & " of " & ColumnCount)
----> For Each CellToColour In ThisTable.Columns(ColumnCounter)
With CellToColour.Shading
.ForegroundPatternColor = FirstForegroundColour
.BackgroundPatternColor = FirstBackgroundColour
.Texture = FirstTexture
End With
Next CellToColour
End If
If ColumnCounter Mod 2 = 0 Then 'even numbered column
For Each CellToColour In ThisTable.Columns(ColumnCounter)
With CellToColour.Shading
.ForegroundPatternColor = SecondForegroundColour
.BackgroundPatternColor = SecondBackgroundColour
.Texture = SecondTexture
End With
Next CellToColour
End If
Next ColumnCounter
End Sub

Sub SetRGBColours()
Black = RGB(0, 0, 0)
Blue = RGB(0, 0, 255)
Green = RGB(0, 255, 0)
Cyan = RGB(0, 255, 255)
Red = RGB(255, 0, 0)
Magenta = RGB(255, 0, 255)
Yellow = RGB(255, 255, 0)
White = RGB(255, 255, 255)
Custom1 = RGB(200, 150, 150)
Custom2 = RGB(100, 100, 100)
End Sub

Sub GridReset()
Set ThisTable = ActiveDocument.Tables(1)
ColumnCount = ThisTable.Columns.Count
RowCount = ThisTable.Rows.Count
MsgBox (RowCount & " rows by " & ColumnCount & " columns")
SetRGBColours
For RowCounter = 1 To RowCount
For ColumnCounter = 1 To ColumnCount
Application.StatusBar = "Processing Row: " & RowCounter & ",
Column " & ColumnCounter
'MsgBox ("Row " & RowCounter & ", Column " & ColumnCounter)
CellToColour = ThisTable.Cell(Row:=RowCounter,
Column:=ColumnCounter)
With CellToColour.Shading
.ForegroundPatternColor = Blue
.BackgroundPatternColor = White
.Texture = wdTextureNone
End With
Next ColumnCounter
Next RowCounter
End Sub

Reply to this Message

Helmut Weber - 10 Mar 2005 10:55 GMT

Hi Peter,
what is the defintion of celltocolour?

By the way, this looks way to complicated for me:

How about this one:

Dim oClm As Column
For Each oClm In ActiveDocument.Tables(1).Columns
If oClm.Index Mod 2 = 0 Then
oClm.Cells.Shading.BackgroundPatternColor =
wdColorLightYellow
Else
oClm.Cells.Shading.BackgroundPatternColor =
wdColorBlue
End If
Next

Beware of linebreaks by the newsreader.

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

Reply to this Message

Peter Rooney - 10 Mar 2005 11:09 GMT

Hi, Helmut,

I agree, it probably is a bit too complicated, but I'm new to Word VBA, so
I'm still finding my way around the object model.

CellToColour was just defined as variant (yes, lazy I know, but it works
until I figure out the correct type to use!) to be the cell object.

Your solution is excellent - this is why I come on here - to learn better
ways of doing things!

Thanks for your help

Pete :))

> Hi Peter,
> what is the defintion of celltocolour?
[quoted text clipped - 20 lines]
> "red.sys" & chr(64) & "t-online.de"
> Word 2002, Windows 2000

Reply to this Message

Greg Maxey - 10 Mar 2005 11:08 GMT

Pete,

I believe the problem with the code you have is that you haven't declared
CellToColour and ThisTable

i.e., Dim CellToColour
Dim ThisTable

Then use:
For Each CellToColour In ThisTable.Columns(ColumnCounter).Cells

That cleared the error but doesn't achieve the desired result. Martin
posted an elegant solution yesterday for checkerboard pattern. It is easily
adapted to stripes as follows:

Sub FormatTable()
If Not Selection.Information(wdWithInTable) Then
MsgBox "Select a table before running this macro"
Exit Sub
End If
Call formatColoredTable(Array(wdBlack, wdRed))
End Sub

Sub formatColoredTable(colors As Variant)
Dim oCell As Cell
Dim numColors As Long
Dim i As Long
Dim isODDTable As Boolean
If Not IsArray(colors) Then Exit Sub
With Selection.Tables(1)
numColors = UBound(colors) - LBound(colors) + 1
isOddTable = (.Columns.Count Mod numColors) = 1
i = 0
For Each oCell In .Range.Cells
oCell.Shading.BackgroundPatternColorIndex = _
colors(i Mod numColors)
i = i + 1
'Increase by 1 to stagger row color if we are at the
'last column of a table with column-count which
'is a multiple of the given number of colors
If oCell.ColumnIndex = .Columns.Count And _
isOddTable Then
i = i + 1
End If
Next
End With
End Sub

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

Signature

Greg Maxey/Word MVP
A Peer in Peer to Peer Support

> Good morning, all!
>
[quoted text clipped - 97 lines]
> Next RowCounter
> End Sub

Reply to this Message

Peter Rooney - 10 Mar 2005 11:49 GMT

Greg,

Actually, I did declare the variables earlier on in the macro sheet, I just
didn't show them here :))

Your example works fine - thank you very much!

Regards

Pete

> Pete,
>
[quoted text clipped - 149 lines]
> > Next RowCounter
> > End Sub

Reply to this Message

Rate this thread: