I need to modify the look and feel of tables in a document based on the
styles used within each cell. I have some code doing exactly what I need it
to...until I hit a merged cell. Ughh. Below are two code samples - the
first, FormatTables() works properly but dies a painful death when it
encounters a merged cell. The second, FormatTables2() doesn't die, it just
leaves the background color for the table object and the merged cells set to
black. I have no idea why.

I need something that will work. Any help would be appreciated.

TIA
gidmanma

---------------------------------
Sub FormatTables()
Dim aTable, aRow, aCell, RowCount
For Each aTable In ActiveDocument.Tables
With aTable
.Spacing = InchesToPoints(0.05)
.AllowPageBreaks = True
.AllowAutoFit = True
.Shading.BackgroundPatternColor = wdColorWhite
.Shading.Texture = wdTextureNone
.PreferredWidthType = wdPreferredWidthPercent
.PreferredWidth = 96 '98
.Borders.Enable = False
.Rows.Alignment = wdAlignRowLeft
.Rows.LeftIndent = InchesToPoints(0.1) 'InchesToPoints(0) '
.Columns.PreferredWidthType = wdPreferredWidthAuto
End With
RowCount = 1
For Each aRow In aTable.Rows
If RowCount = 1 Then
For Each aCell In aRow.Cells
aCell.Shading.BackgroundPatternColor = RGB(233, 231, 224) '
DCT Tan 70% tint
aCell.Shading.ForegroundPatternColor = wdColorAutomatic
aCell.Shading.Texture = wdTextureNone
aCell.PreferredWidthType = wdPreferredWidthAuto
'aCell.PreferredWidthType = wdPreferredWidthPercent
'aCell.PreferredWidth = 25
Next aCell
Else
For Each aCell In aRow.Cells
aCell.Shading.BackgroundPatternColor = RGB(248, 247, 245) '
DCT Tan 90% tint
aCell.Shading.ForegroundPatternColor = wdColorAutomatic
aCell.Shading.Texture = wdTextureNone
aCell.PreferredWidthType = wdPreferredWidthAuto
'aCell.PreferredWidthType = wdPreferredWidthPercent
'aCell.PreferredWidth = 25
Next aCell
End If
RowCount = RowCount + 1
Next aRow
Next aTable
End Sub
---------------------------------
Sub FormatTables2()
If ActiveDocument.Tables.Count = 0 Then
Exit Sub 'Make sure there are tables in the doc...
Else
'Cycle through the tables / cells and check the style of the cell
contents
'Adjust the background colors accordingly:
' Table Heading - RGB(233, 231, 224) DCT Tan 70% tint
' Table Body Text - RGB(248, 247, 245) DCT Tan 90% tint
' Other - No Color (white)
Dim aTable As Table
Dim aRow As Row
Dim aCell As Cell
Dim aStyle As Style
Dim RowCount

For Each aTable In ActiveDocument.Tables
With aTable
.Spacing = InchesToPoints(0.05)
.AllowPageBreaks = True
.AllowAutoFit = True
.Shading.BackgroundPatternColor = wdColorWhite
.Shading.Texture = wdTextureNone
.PreferredWidthType = wdPreferredWidthPercent
.PreferredWidth = 96 '98
.Borders.Enable = False
.Rows.Alignment = wdAlignRowLeft
.Rows.LeftIndent = InchesToPoints(0.1) 'InchesToPoints(0) '
.Columns.PreferredWidthType = wdPreferredWidthAuto
End With
'==========================
'Dim temp, msg
'msg = MsgBox("Pause Here", vbOKOnly)
'==========================
Set aCell = aTable.Cell(1, 1)
Do
'==========================
'msg = "Col:" & aCell.ColumnIndex & " Row:" & aCell.RowIndex & " | " &
aCell.Range.Style
'temp = MsgBox(msg, vbOKOnly)
'==========================
' For Each aCell In aTable.Range.Cells
Set aStyle = aCell.Range.Style

'Select Case aCell.Range.Style
Select Case aStyle
Case "Table Heading"
aCell.Shading.BackgroundPatternColor = RGB(233, 231,
224) ' DCT Tan 70% tint
aCell.Shading.ForegroundPatternColor =
wdColorAutomatic
aCell.Shading.Texture = wdTextureNone
aCell.PreferredWidthType = wdPreferredWidthAuto
Case "Table Body Text"
aCell.Shading.BackgroundPatternColor = RGB(248, 247,
245) ' DCT Tan 90% tint
aCell.Shading.ForegroundPatternColor =
wdColorAutomatic
aCell.Shading.Texture = wdTextureNone
aCell.PreferredWidthType = wdPreferredWidthAuto
Case Else 'do nothing
aCell.Shading.BackgroundPatternColor = wdColorWhite
aCell.Shading.ForegroundPatternColor =
wdColorAutomatic
aCell.Shading.Texture = wdTextureNone
aCell.PreferredWidthType = wdPreferredWidthAuto
End Select
'Next aCell
Set aCell = aCell.Next
Loop Until aCell Is Nothing
Next aTable
End If
End Sub
---------------------------------

.... Sorry.. it had been a little while since I looked at the first sub
FormatTables(). It does not read the style of the Cell contents - it was
just a hack job to get past the first release The FormatTables2() is the
one I need to go with... once it works.

Thanks
gidmanma

A very interesting feature.

From a few quick tests, in a new document create a table and merge a block
of cells at least two rows deep vertically and run this code:

With ActiveDocument.Tables(1)
.Shading.BackgroundPatternColor = wdColorWhite
.Shading.Texture = wdTextureNone
End With

Then repeat the test but this time run this code:

With ActiveDocument.Tables(1)
.Shading.Texture = wdTextureNone
.Shading.BackgroundPatternColor = wdColorWhite
End With

Spot the difference?.

So, to workaround this feature, you can change your code in four places to
put the setting of the shading BackgroundPatternColor after the setting of
the shading texture (once in the "with atable" block and three times in the
"select case" block later)

--
Enjoy,
Tony


"gidmanma" wrote in message
...
... Sorry.. it had been a little while since I looked at the first sub
FormatTables(). It does not read the style of the Cell contents - it was
just a hack job to get past the first release The FormatTables2() is
the
one I need to go with... once it works.

Thanks
gidmanma

Thanks Tony - worked perfectly!

Here's the final subroutine. It might help someone else along the way...

gidmanma

-------------------------------------------------------------
The goal of this subroutine is to set certain table and cell properties on
tables in your document that contain cells of a specific stlye. In our
environment, each cell will contain paragraphs of the same style. This code
will need additional tweaking to handle instances where a cell has paragraphs
of different styles within it.
-------------------------------------------------------------

Sub FormatTables()

'================================================= =================================
' Loop through the tables in the document. If the table contains
cells with
' one of our AuthorIT table styles then format it accordingly.
Otherwise skip it.

'================================================= =================================
If ActiveDocument.Tables.Count = 0 Then
Exit Sub 'Make sure there are tables in the doc...
Else
'Cycle through the tables / cells and check the paragraph style of
the cell contents
'Adjust the background colors accordingly:
' Table Heading - RGB(233, 231, 224) DCT Tan 70% tint
' Table Body Text - RGB(248, 247, 245) DCT Tan 90% tint
' Table List Bullet - RGB(248, 247, 245) DCT Tan 90% tint
' Other - No Color (white)
Dim aTable As Table
Dim aCell As Cell
Dim aStyle As Style
Dim RowCount, TableType

'- Loop through the tables -----------------------
For Each aTable In ActiveDocument.Tables
TableType = "Other" ' Other|DCTAuthorIT ...can extend this list
as need occurs
'- Loop through the cells -----------------------
Set aCell = aTable.Cell(1, 1)
Do
aCell.Range.Collapse (wdCollapseEnd)
Set aStyle = aCell.Range.Paragraphs.Item(1).Style
'Dim msg
'msg = MsgBox(aCell.Range.Style, vbOKOnly)
Select Case aStyle
Case "Table Heading"
If Not (TableType = "DCTAuthorIT") Then TableType =
"DCTAuthorIT"
aCell.PreferredWidthType = wdPreferredWidthAuto
aCell.Shading.Texture = wdTextureNone
aCell.Shading.BackgroundPatternColor = RGB(233, 231,
224) ' DCT Tan 70% tint
Case "Table Body Text"
If Not (TableType = "DCTAuthorIT") Then TableType =
"DCTAuthorIT"
aCell.PreferredWidthType = wdPreferredWidthAuto
aCell.Shading.Texture = wdTextureNone
aCell.Shading.BackgroundPatternColor = RGB(248, 247,
245) ' DCT Tan 90% tint
Case "Table List Bullet"
If Not (TableType = "DCTAuthorIT") Then TableType =
"DCTAuthorIT"
aCell.PreferredWidthType = wdPreferredWidthAuto
aCell.Shading.Texture = wdTextureNone
aCell.Shading.BackgroundPatternColor = RGB(248, 247,
245) ' DCT Tan 90% tint
Case Else
'do nothing
End Select
Set aCell = aCell.Next
Loop Until aCell Is Nothing
'- Format the table if necessary --------------------
Select Case TableType
Case "DCTAuthorIT"
With aTable
.Spacing = InchesToPoints(0.05)
.AllowPageBreaks = True
.AllowAutoFit = True
.Borders.Enable = False
.Rows.Alignment = wdAlignRowLeft
.Rows.LeftIndent = InchesToPoints(0.1)
.Columns.PreferredWidthType = wdPreferredWidthAuto
.PreferredWidthType = wdPreferredWidthPercent
.PreferredWidth = 96 '98
End With
Case Else
'do nothing
End Select
Next aTable
End If
End Sub