Work Breakout table formatter

Option Explicit

Sub Table_Format_bottom_right()
    Dim objTable As Table
    Dim I As Integer
    
    Set objTable = Selection.Tables(1)
    
    With objTable
        ''Padding to 0
        .TopPadding = InchesToPoints(0)
        .BottomPadding = InchesToPoints(0)
        .LeftPadding = InchesToPoints(0.001)
        .RightPadding = InchesToPoints(0)
        
        ''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
        
        For I = 1 To objTable.Columns.Count - 1
            objTable.Columns(I).AutoFit
        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
        
        
    End With
End Sub
Sub ShadeMod(ObjVar As Variant, I As Integer)
    ObjVar.Shading.BackgroundPatternColor = ModColor(I)
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
        .Color = wdColorGray50
    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

Comments

Popular posts from this blog

Revit area plans adding new types and references (Gross and rentable)

Organization and management of data in Revit across omniclass, Masterformat, Uniclass, and Uniformat