Apply Uniform Table Borders to All Tables

Situation: You have a document with several tables. The tables have different borders or another border style than desired. You want all the tables to have uniform borders. You may have experienced that this can be rather time-consuming if you have to correct the tables one by one. Here you will find a macro that corrects the table borders of all table cells in all tables in one operation.

Macro solution

Example – before and after executing the macro

In the ApplyUniformBordersToAllTables macro, adjust the border width, style and color to fit your needs. The examples below show how diffent tables will appear after executing the macro with the predefined border settings.

Tables before executing the macro

Example - tables before executing the macro

Tables after executing the macro

Note that the third table contained table cells with no borders. The macro applies borders to such cells too.

Example - tables after executing the macro

The macro

Below, you will find the macro code. If you need help on installing macros, see How to install a macro.

Option Explicit

Sub ApplyUniformBordersToAllTables()
    
    '=========================
    'Macro created 2007 by Lene Fredborg, DocTools - www.thedoctools.com
    'THIS MACRO IS COPYRIGHT. YOU ARE WELCOME TO USE THE MACRO BUT YOU MUST KEEP THE LINE ABOVE.
    'YOU ARE NOT ALLOWED TO PUBLISH THE MACRO AS YOUR OWN, IN WHOLE OR IN PART.    
    '=========================
    'The macro applies uniform table borders to all tables in the active document
    '26-Sep-2008: Adjusted to handle tables with only one row or column
    
    'Insert the desired values of oBorderStyle, oBorderWidth and oBorderColor
    '=========================
    
    Dim Title As String
    Dim Msg As String
    Dim Style As VbMsgBoxStyle
    Dim Response As VbMsgBoxResult
    
    Dim oTable As Table
    Dim oBorderStyle As WdLineStyle
    Dim oBorderWidth As WdLineWidth
    Dim oBorderColor As WdColor
    Dim oarray As Variant
    
    Dim n As Long
    Dim i As Long
    
    '=========================
    'Change the values below to the desired style, width and color
    oBorderStyle = wdLineStyleSingle
    oBorderWidth = wdLineWidth050pt
    oBorderColor = wdColorBlack
    '=========================
    
    Title = "Apply Uniform Borders to All Tables"
    
    If ActiveDocument.Tables.Count > 0 Then
        Msg = "This command applies uniform table borders " & _
                "to all tables in the active document." & vbCr & vbCr & _
                "Do you want to continue?"
        Style = vbYesNo + vbQuestion
        Response = MsgBox(Msg, Style, Title)
        'Stop if user did not click Yes
        If Response <> vbYes Then Exit Sub
    Else
        'Stop - no tables are found
        MsgBox "The document contains no tables.", vbInformation, Title
        Exit Sub
    End If
        
    'Define array with the borders to be changed
    'Diagonal borders not included here
    oarray = Array(wdBorderTop, _
        wdBorderLeft, _
        wdBorderBottom, _
        wdBorderRight, _
        wdBorderHorizontal, _
        wdBorderVertical)
        
    For Each oTable In ActiveDocument.Tables
        'Count tables - used in message
        n = n + 1
        With oTable
            For i = LBound(oarray) To UBound(oarray)
                
                'Skip if only one row and wdBorderHorizontal
                If .Rows.Count = 1 And oarray(i) = wdBorderHorizontal Then GoTo Skip
                'Skip if only one column and wdBorderVertical
                If .Columns.Count = 1 And oarray(i) = wdBorderVertical Then GoTo Skip
                
                With .Borders(oarray(i))
                    .LineStyle = oBorderStyle
                    .LineWidth = oBorderWidth
                    .Color = oBorderColor
                End With
            Next i
        End With
Skip:
    Next oTable
    
    MsgBox "Finished applying borders to " & n & " tables.", vbOKOnly, Title

End Sub

Related information

See About VBA Macros and Code Snippets and How to Install a Macro for misc. information that may help you in your work with macros and for information about how to install macros.