Home |
Search |
Today's Posts |
|
#1
|
|||
|
|||
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 |
Reply |
Thread Tools | |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
formatting numeric data from Access merged into a Word table | Mailmerge | |||
formatting numbers mail merged into Word table from an Excel Works | Tables | |||
Sum Above table with merged cells in Word 2003 | Microsoft Word Help | |||
Adding columns in table with merged cells | Tables | |||
How to remove unwanted formatting in mail merge for cells witn no | Mailmerge |