VBA to Make a Word Table with Borders

Quick Jump

Download

Download BAS file to import into a VBA project to create a table in any Word document -- designed to run in Word as well as using automation from Access, Excel, or something else.
mod_Word_MakeTable_s4p__BAS.zip

Remember to UNBLOCK files you download to remove the Mark of the Web. Here are steps to do that: https://msaccessgurus.com/MOTW_Unblock.htm

VBA

Standard Module

When you want to write tabular information in Word, creating a table to hold the data works beautifully. The WordMakeTable_s4p procedure returns the table object just created.

The table is a 2-dimensional array and each cell can be referenced with:

oTable.cell(RowNumber, ColumnNumber).Range.Text = "whatever you want"

Where:
oTable is the object reference for the table
RowNumber, ColumnNumber is the long integer row and column number

'*************** Code Start *****************************************************
' module name: mod_Word_MakeTable_s4p
'-------------------------------------------------------------------------------
' Purpose  : VBA to create a table in Word
'              send document and range objects
'              specify number of rows and columns
'              optionally add Caption
'              optionally add borders and shading to first row
'              optionally send column headings
' Author   : crystal (strive4peace)
' Code List: www.MsAccessGurus.com/code.htm
' This code: https://msaccessgurus.com/VBA/Word_MakeTable.htm
' LICENSE  :
'   You may freely use and share this code, but not sell it.
'   Keep attribution. Use at your own risk.
'-------------------------------------------------------------------------------
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'           WordMakeTable_s4p
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Public Function WordMakeTable_s4p(oDoc As Object _ 
   ,oRange As Object _ 
   ,ByVal pnRows As Long _ 
   ,ByVal pnCols As Long _ 
   ,Optional ByVal psCaption As String =  "" _ 
   ,Optional pbDoBorders As Boolean = True _ 
   ,Optional ByVal paHeadArray As Variant _ 
   ) As Object  'As Word.Table
'strive4peace 170811, 20202, 220420, 230619 array headings, 22
   ' PARAMETERS
   '  oDoc os the document object
   '  oRange is a range object where to insert table
   '  pnRows is a long integer number of rows
   '  pnCols is a long integer number of columns
   ' OPTIONAL
   '  psCaption os a caption -- start with space or period space
   '  pbDoBorders = True to add borders and shading for the first row
   '  paHeadArray os a vriant array with column headings
   
   'early binding
'   Dim oTable As Word.Table

   'late binding
   Dim oTable As Object 
   
   Dim i As Integer _ 
      ,iCol As Integer 
   
   'insert table
   With oDoc 
      Set oTable = .Tables.Add( _ 
         Range:=oRange _ 
         ,NumRows:=pnRows _ 
         ,NumColumns:=pnCols _ 
         ) 

   End With 
 
   If (psCaption <>  "") Then 
      'insert caption
      oDoc.Application.Selection.InsertCaption _ 
            Label:= "Table" _ 
            ,Title:=psCaption _ 
            ,Position:=0 _ 
            ,ExcludeLabel:=0 
   End If 
      
   With oTable 
      'Position - wdCaptionPositionAbove=0
'      .ApplyStyleHeadingRows = True
      .TopPadding = 0 
      .BottomPadding = 0 
      .LeftPadding = 2  'points
      .RightPadding = 2 
      .Spacing = 0  'Auto
      .AllowPageBreaks = True 
      .AllowAutoFit = False 

      'dont allow rows to break
      .Rows.AllowBreakAcrossPages = False 
 
      'no space above text between paragraphs
      .Range.Paragraphs.SpaceBefore = 0 
 
      'Vertical Alignment is Center
      .Range.Cells.VerticalAlignment = 1  ' 1=wdCellAlignVerticalCenter
 
      'Heading Row
      If Not IsMissing(paHeadArray) Then 
         'mark heading row
         .Rows(1).HeadingFormat = True 
         iCol = 1 
         For i = LBound(paHeadArray) To UBound(paHeadArray) 
            .Cell(1,iCol).Range.Text = paHeadArray(i) 
            iCol = iCol + 1 
         Next i  'array element
      End If 
      
      If pbDoBorders Then 
         Call WordTableBorders_s4p(oTable) 
      End If 
      
      'best-fit columns
      .Columns.AutoFit 
         
   End With 
 
   Set WordMakeTable_s4p = oTable 
 
End Function 

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'           WordTableBorders_s4p
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'Object is 'Word.Table
Public Sub WordTableBorders_s4p(oTable As Object) 
's4p 170811
   Dim i As Integer 
   With oTable 
      For i = 1 To 6 
         'wdBorderTop =-1
         'wdBorderLeft = -2
         'wdBorderBottom =-3
         'wdBorderRight= -4
         'wdBorderHorizontal = -5
         'wdBorderVertical = -6
         With .Borders(-i) 
            .LineStyle = 1   'wdLineStyleSingle=1
            .LineWidth = 8  'wdLineWidth100pt=8. wdLineWidth150pt=12
            .Color = RGB(200,200,200)  'medium-light gray
         End With 
      Next i 
   End With 
   'change borders to black for first row
   With oTable.Rows(1) 
      For i = 1 To 4 
         With .Borders(-i) 
            .Color = 0       'wdColorBlack = 0
         End With 
      Next i 
      'Shading for header row
      .Shading.BackgroundPatternColor = RGB(232,232,232) 
   End With  'first row
   'Not used:
'      'wdLineStyleNone = 0
'      .Borders(-7).LineStyle = 0 'wdBorderDiagonalDown =-7
'      .Borders(-8).LineStyle = 0 'wdBorderDiagonalUp =-8
End Sub 

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'           test_WordMakeTable
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'mod_test_WordMakeTable_s4p
Public Sub test_WordMakeTable() 
'230619 s4p
' make a table where the cursor is in the active document,
'  in a new next paragraph

   'CLICK HERE
   'Press F5 to run for ActiveDocument
   
   Dim oRange As Word.Range 
   
   Dim nRows As Long _ 
      ,nCols As Long _ 
      ,i As Integer _ 
      ,sCaption As String 
      
   '------------------------- CUSTOMIZE!
   Dim aHeadings(1 To 4) As Variant 
   nRows = 2 
   nCols = 4 
   '-------------------------
   
   sCaption =  " Table containing " _ 
      & nRows &  " rows, and " _ 
      & nCols &  " columns" _ 
      &  " with borders and best-fit columns"
      
   'make up fake column names
   For i = 1 To nCols 
      aHeadings(i) =  "Column " & i 
      'make heading longer for last column
      If i = nCols Then 
         aHeadings(nCols) = aHeadings(nCols) _ 
            &  " is a description so it's wider"
      Else 
         aHeadings(nCols) = aHeadings(nCols) _ 
            &  " Heading"
      End If 
   Next i 
   
   '-------------------------
   'collapse to end of selection
   Set oRange = Selection.Range 
   With oRange 
      .Collapse 0  'wdCollapseEnd
      'insert new paragraph
      .InsertParagraphAfter 
      .Collapse 0  'wdCollapseEnd
   End With 
   
   'make table with caption, with borders, heading labels
   Call WordMakeTable_s4p( _ 
      ActiveDocument _ 
      ,oRange _ 
      ,nRows _ 
      ,nCols _ 
      ,sCaption,True,aHeadings) 
   
   MsgBox  "Done making table",, "Done"
   
End Sub 
'*************** Code End *******************************************************

Reference

VBA on this site

Word automation reference and VBA Code

WordAutomate.htm

VBA to list Word Document Property names and values and Reference how to use Word Built-in and Custom Document Properties

Word_DocumentProperties.htm

Microsoft Help

Help: Table object (Word)

Help: Tables.Add method (Word)

Help: Range.InsertCaption method (Word)

Help: Column.AutoFit method (Word)

Help: IsMissing function (VBA)

Help: LBound function (VBA)

Help: UBound function (VBA)

Backstory

Lots of information is in rows and columns — this gives you a way to make the data look good!

Share with others

Get Tutoring building applications

Let's connect and team-develop your application together. You have the business knowledge; I know how to design and automate and am a teacher. I show you how to do it yourself. My goal is to empower you as I believe you should hold the reins on your important information and strategies.

While we build something great together, I'll pull in code and features from my vast libraries as needed, cutting out lots of development time. And you'll get links to great resources.

Maybe you want all the code in Word -- or maybe you're managing Word from Access or Excel. I can help you in any case. Let's connect. Email me at training@msAccessGurus.com

~ crystal

the simplest way is best, but usually the hardest to see