TOOLS: Word - Table Formatting Macro

["Steve Hudson" <steve -at- wright -dot- com -dot- au>]

Its taken me 4 hours, but I finally have this sucka whipped.

Although the macros AS THEY ARE are of limited use (they will only style a
certain table my way), they contain lots of helpful pointers for achieving
auto-styling.

Their current functionality:

+--------------------+
+-----+-------------+
+-----+-------------+
+-----+-----+---+--+
+-----+-----+---+--+
+-----+-----+---+--+
+-----+-------------+
+-----+-------------+

Row 1 is always a single cell. Rows 2-n are always at least 2, with a common
1st column width.
Column 1 is for headings, H3 in Row1 and H4 in all other rows.
H3 has a stronger shading level than H4, all other cells are blank.
Line widths are 1.5pt outside, 1 pt inside, 0 for minor cells inside of big
column 2. Column 1's & row 1's inside borders are also 1.5

Some minor style points to address, but SHE WORKS woo hoo!!! The methodology
should assist others with similar goals.

Sub MyStyleTable()
    If Selection.Information(wdWithInTable) = False Then Exit Sub
    mstOutside
    mstInside
    mstHeading
    mstCells
    mstCol1
End Sub

Sub mstOutside()
    Dim k As Long
    With Options
        .DefaultBorderLineStyle = wdLineStyleSingle
        .DefaultBorderLineWidth = wdLineWidth100pt
        .DefaultBorderColor = wdColorAutomatic
    End With
    With Selection.Tables(1)
        .Borders.Shadow = False
        For k = -4 To -1 ' do all outside borders
            With .Borders(k)
                .LineStyle = wdLineStyleSingle
                .LineWidth = wdLineWidth150pt
                .Color = wdColorAutomatic
            End With
        Next
    End With
End Sub

Sub mstInside()
    Dim k As Long
    With Selection.Tables(1)
        For k = -6 To -5 'inside borders
            With .Borders(k)
                .LineStyle = wdLineStyleSingle
                .LineWidth = wdLineWidth100pt
                .Color = wdColorAutomatic
            End With
        Next
        .Borders(wdBorderDiagonalDown).LineStyle = wdLineStyleNone
        .Borders(wdBorderDiagonalUp).LineStyle = wdLineStyleNone
        .Borders.Shadow = False
    End With
End Sub

Sub mstHeading()
    Dim k As Long
    With Selection.Tables(1).Cell(1, 1)
        .Range.Style = "Heading 3"
        For k = -4 To -1 'outside borders
            With .Borders(k)
                .LineStyle = wdLineStyleSingle
                .LineWidth = wdLineWidth150pt
                .Color = wdColorAutomatic
            End With
        Next
        With .Shading
            .Texture = wdTextureNone
            .ForegroundPatternColor = wdColorAutomatic
            .BackgroundPatternColor = wdColorGray30
        End With
    End With
End Sub

Sub mstCol1()
    Dim k As Long
    Dim r As Word.Range
    Selection.Tables(1).Cell(2, 1).Select
    Selection.SelectColumn
    Selection.SetRange Start:=Selection.Cells(2).Range.Start,
End:=Selection.End 'all cells in col1 bar first
    With Selection
        .Style = "Heading 4"
        With .Cells.Shading
            .Texture = wdTextureNone
            .ForegroundPatternColor = wdColorAutomatic
            .BackgroundPatternColor = wdColorGray15
        End With
        With .Borders(wdBorderRight)
            .LineStyle = wdLineStyleSingle
            .LineWidth = wdLineWidth150pt
            .Color = wdColorAutomatic
        End With
    End With
End Sub

Sub mstCells()
    Dim kRow As Long, kCells As Long
    Dim r As Word.Range
    Dim Flag As Boolean

    With Selection.Tables(1)
        For kRow = 2 To .Rows.Count
            .Cell(kRow, 2).Select
            With Selection
                .SelectRow
                Flag = True
                If .Information(wdHorizontalPositionRelativeToPage) > -1
Then 'first column is at abs left
                    .SetRange Start:=.Cells(2).Range.Start, End:=.End 'move
past it - we dont style col1 here
                    Flag = False
                End If
                If .Columns.Count > 1 Then 'minor cells exist
                    .Borders(wdBorderVertical).LineStyle = wdLineStyleNone
                    If Flag Then
                        .Borders(wdBorderTop).LineStyle = wdLineStyleNone
                    Else
                        .Borders(wdBorderTop).LineStyle = wdLineStyleSingle
                    End If
                Else
                    .Borders(wdBorderTop).LineStyle = wdLineStyleSingle
                End If
            End With
        Next
    End With
End Sub

Steve Hudson
Principal Technical Writer
Wright Technologies (Aus)
steve -at- wright -dot- com -dot- au
(612) 9518-1822
The best way to predict the future... is to create it!



^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

A landmark hotel, one of America's most beautiful cities, and 
three and a half days of immersion in the state of the art:
IPCC 01, Oct. 24-27 in Santa Fe.  http://ieeepcs.org/2001/

  +++  Miramo -- Database/XML publishing automation.  See us at  +++
  +++  Seybold SFO, Sept. 25-27, in the Adobe Partners Pavilion  +++
  +++ More info: http://www.axialinfo.com  http://www.miramo.com +++

---
You are currently subscribed to techwr-l as: archive -at- raycomm -dot- com
To unsubscribe send a blank email to leave-techwr-l-obscured -at- lists -dot- raycomm -dot- com
Send administrative questions to ejray -at- raycomm -dot- com -dot-  Visit 
http://www.raycomm.com/techwhirl/ for more resources and info.