Wednesday, February 24, 2016

TABLE FORMAT v2.0

Table Format V2.0



Option Explicit

Sub Table_Format_bottom_right()
    Dim objTable As Table
    Dim I As Integer
    
    Set objTable = Selection.Tables(1)
    
    With objTable
        ''format colors
        For I = objTable.Columns.Count To 1 Step -1
            ''Shading
            ShadeMod .Columns(I), I
            ShadeMod .Rows(I), I
            
            ''borders
            BDR_NONE objTable.Columns(I).Borders(wdBorderHorizontal)

            BDR_NONE objTable.Rows(I).Borders(wdBorderVertical)

            BDR_Single objTable.Columns(I).Borders(wdBorderLeft)

            BDR_Single objTable.Rows(I).Borders(wdBorderTop)

        Next I
        

        I = objTable.Rows.Count
        'objTable.Columns(I).Borders(wdBorderVertical).LineStyle = wdLineStyleDashSmallGap
        BDR_Dash objTable.Rows(objTable.Rows.Count).Borders(wdBorderVertical)
        
        BDR_Double objTable.Rows(objTable.Rows.Count).Borders(wdBorderTop)
        
        BDR_Thin objTable.Columns(objTable.Columns.Count).Borders(wdBorderLeft)
        
        For I = -4 To -1
            BDR_Thick objTable.Borders(I)
        Next I
        
        With objTable
            With .Rows(objTable.Rows.Count)   ''last row
                ''''.Alignment = wdAlignRowCenter ''screws up table row centering it in the page- shifting it from the rest of table.
                With .Range
                    .ParagraphFormat.Alignment = wdAlignParagraphCenter
                    .Cells.VerticalAlignment = wdCellAlignVerticalTop
                    .Font.Bold = True
                End With
            End With
            objTable.Cell(.Rows.Count, .Columns.Count).Range.ParagraphFormat.Alignment = wdAlignParagraphLeft
        End With
        TableInsertCaption
    End With
End Sub
Sub ShadeMod(ObjVar As Variant, I As Integer)
    ObjVar.Shading.BackgroundPatternColor = ModColor(I)
End Sub

Public Sub TableInsertCaption(Optional objTable As Table)
    On Error Resume Next
    
    If objTable Is Nothing Then Set objTable = Selection.Tables(1)
    If objTable Is Nothing Then
        MsgBox "Please select a table first.", vbExclamation, "Error"
        Exit Sub
     End If
            
        
        objTable.Range.InsertCaption _
            Label:=wdCaptionTable, _
            Position:=wdCaptionPositionAbove
End Sub

Sub BDR_NONE(Bdr As Border) ''clear borders
    With Bdr
        .LineStyle = wdLineStyleSingle
        .LineWidth = wdLineWidth100pt
        .LineStyle = wdLineStyleNone
    End With
End Sub

Sub BDR_Single(Bdr As Border)
    With Bdr
        .LineStyle = wdLineStyleSingle
        .LineWidth = wdLineWidth100pt
    End With
End Sub

Sub BDR_Thin(Bdr As Border)
    With Bdr
        .LineStyle = wdLineStyleSingle
        .LineWidth = wdLineWidth025pt
    End With
End Sub

Sub BDR_Dash(Bdr As Border)
    With Bdr
        .LineStyle = wdLineStyleDashLargeGap
        .LineWidth = wdLineWidth025pt
    End With
End Sub

Sub BDR_Thick(Bdr As Border)
    With Bdr
        .LineStyle = wdLineStyleSingle
        .LineWidth = wdLineWidth150pt
    End With
End Sub
Sub BDR_Double(Bdr As Border)
    With Bdr
        .LineStyle = wdLineStyleDouble
        ''.LineWidth = wdLineWidth100pt  '' no line width for complex line styles
    End With
End Sub

Function ModColor(I As Integer) As Long
Dim Colors As New Collection
    ''add colors for order of rotation
        Colors.Add -603914241   ''white
        Colors.Add -603923969   ''gray
        Colors.Add -721354957   ''light purple

ModColor = Colors.Item((I Mod Colors.Count) + 1)

End Function

No comments:

Post a Comment