VBA Code
All cell values in a table end in Chr(13) & Chr(7)
Be careful when using the VBA code Selection.MoveEnd as you can extend a selection by two characters and end up selecting two whole rows in a table
When you are at the "endofrowmark" in a table you are still considered within the table (ie selection.information(wdwithintable) = True
Dim objTable As Word.Table
objTable = ActiveDocument.Range.Tables.Add( , row, column)
If objRange.Information(wdInformation.wdWithinTable) = True Then
End If
Range Object
Dim objCell As Word.Cell
objCell = objTable.Cell(row,column)
objCell.Range.Text = "some text"
objTable.Row(1).Range.Bold = 1 ' True
objTable.Row(1).Range.Bold = 0 ' False
objTable.Row(1).Range.Bold = - 1'undefined = wdConstants.wdUndefined
objTable.AutoFitBehaviour(wdAutoFitBehavior.wdAutoFitContent)
rows(1).spacebetweencolumns = 0
documents("Temp.doc").tables(3)
activedocument.tables(1).range.cells.range.insertbefore text:="cell" & 5
.rows.allowbreakacrosspages = false
.converttotable seperator:=wdseperatebytabs,
numcolumns:="",
numrows:="",
format:=wdtableformatnone,
applyborders:=true,
applyshading:=true,
applyfont:=true,
applycolor:=true,
applyheadingrows:=true,
applylastrow:=false,
applyfirstcolumn:=true,
aplylastcolumn:=false,
autofit:=false
Select Continuous Cells
Set objRange = ActiveDocument.Range(Start:=.Tables(1).Cell(2,2).Range.Start, _
End:=.Tables(1).Cell(4,4).Range.End)
This will create a range for a continuous group of cells.
The start must occur before the end, both in terms of rows and columns
The Row, Rows and Table objects have a ConvertToText method that converts table data to text and returns a range object representing the text.
expression.ConvertToText(separator)
separator - optional character to delimit the text
Set objTable = ActiveDocument.Tables(1)
Set objRange = objTable.ConvertToText(wdTableFieldSeparator.wdSeparateByParagraphs)
Selection.MoveRight Unit:=wdUnits.wdCell
Selection.MoveRight Unit:=wdUnits.wdCell, _
Count:=3
Selection.MoveRight Unit:=wdUnits.wdCell, _
Count:=3, _
Extend:=wdMovementType.wdExtend
Move to the first table in the document
Selection.GoTo What:=wdGoToTable, _
Which:=wdGoToFirst, _
Count:=1, _
Name:=""
How many tables in a document
ActiveDocument.Tables.Count
Removes borders from active table
Selection.Tables(1).Borders.Enable = False
Get the Index number of the current table
Define a range from the start of the document to the end of the first selected paragraph
Msgbox (ActiveDocument.Range(0,Selection.Paragraphs(1).Range.End).Tables.Count)
ActiveWindow.View.TableGridlines = True
Insert Formula
Selection.InsertFormula Formula:="=SUM(ABOVE)", _
NumberFormat:="#,##0,00"
There is a built in ConvertToTable command - YES !!!
If (Selection.Information(wdInformation.wdWithInTable) = False) Then
Call MsgBox("You are not in a table!")
End If
Returning text from a table cell with no end marker
Set tblTable = ActiveDocument.Tables(1)
For Each clCell in tblTable.Rows(1).Cells
Set rgeRange = ActiveDocument.Range(start := clCell.Range.Start, end := clCell.Range.End - 1)
Call Msgbox(rgeRange.Text)
Next clCell
Adding a formula
Selection.InsertFormula Formula:="=SUM(ABOVE)", NumberFormat:="#,##0.00"
With bookmarks
This line puts the bookmark around the actual text - if the text is removed so is the bookmark
oRange.Text = "some text"
ActiveDocument.Bookmarks.Add Name:="BM_Name", Range:=oRange
This line puts the boomark around the actual cell - if the text is removed, the bookmark stays
ActiveDocument.Bookmarks.Add Name:="BM_Name", Range:=oTable.Cell(1, 1).Range
Turning 'Allow spacing between cells' off with VBA in a Word 2000 table
There seems to be no supported way in VBA to turn the "Allow spacing between cells" Table property off.
You can set the Spacing property to 0 but the resulting table looks very different from how it looks if you de-select the "Allow spacing between cells" checkbox manually using the (Table > Properties) dialog.
Workaround 1:
Selection.Tables(1).Spacing = -1
makes the table look right.
It is not ideal, because if you then look in the dialog you'll see that "Allow spacing" is still ticked - but it's much better than no workaround at all!
Workaround 2:
SendKeys "%s{Enter}"
Dialogs(1080).Show
also works. This second workaround has the advantage that it does de-select the "Allow spacing" checkbox in the dialog - but besides the inherent disadvantage in using SendKeys, the user will see the dialog momentarily appear and disappear.
VBA - Creating
Tables.Add
Dim oTable As Word.Table
Set oTable = ActiveDocument.Tables.Add(Range:=Selection.Range, _
NumRows:=3, _
NumColumns:=4, _
DefaultTableBehavior:=wdDefaultTableBehavior.wdWord8TableBehavior, _
AutoFitBehavior:=wdAutoFitBehavior.wdAutoFitWindow)
Range - The range where you want the table to appear. The table replaces the range, if the range isn't collapsed.
NumRows - The number of rows you want to include in the table.
NumColumns - The number of columns you want to include in the table.
DefaultTableBehavior - Sets a value that specifies whether Microsoft Word automatically resizes cells in tables to fit the cells' contents (AutoFit).
AutoFitBehavior - Sets the AutoFit rules for how Word sizes tables.
ActiveDocument.Tables.Add Range:=myRange, NumRows:=3, NumColumns:=4
Sub NewTable()
Dim docNew As Word.Document
Dim tblNew As Word.Table
Dim intX As Integer
Dim intY As Integer
Set docNew = Documents.Add
Set tblNew = docNew.Tables.Add(Selection.Range, 3, 5)
With tblNew
For intX = 1 To 3
For intY = 1 To 5
.Cell(intX, intY).Range.InsertAfter "Cell: R" & intX & ", C" & intY
Next intY
Next intX
.Columns.AutoFit
End With
End Sub
Nested Tables
Public Sub InsertNested()
Documents.Add
ActiveDocument.Tables.Add Selection.Range, 3, 3, wdWord9TableBehavior, wdAutoFitContent
With ActiveDocument.Tables(1).Range
.Copy
.Cells(1).Range.Text = .Cells(1).NestingLevel
.Cells(5).Range.PasteAsNestedTable
With .Cells(5).Tables(1).Range
.Cells(1).Range.Text = .Cells(1).NestingLevel
.Cells(5).Range.PasteAsNestedTable
With .Cells(5).Tables(1).Range
.Cells(1).Range.Text = .Cells(1).NestingLevel
End With
.Columns(2).Select
Selection.TopLevelTables(1).Select
End With
End With
End Sub
oTable.PreferredWidthType = wdPreferredWidthType.wdPreferredWidthPoints
oTable.PreferredWidth = 50
oTable.Rows.VerticalPosition = 0 (single value)
oTable.Rows.Alignment = wdRowAlignment.wdAlignRowLeft
oTable.Rows.HorizontalPosition = 0 (single value)
oTable.Rows.HeightRule = wdRowHeightRule.wdRowHeightAuto
oTable.Rows.RelativeHorizontalPosition = wdRelativeHorizontalPosition.wdRelativeHorizontalPositionPage
oTable.Rows.RelativeVerticalPosition = wdRelativeVerticalPosition.wdRelativeVerticalPositionMargin
What is the difference between ??
oTable.Style = objstyle
oTable.Range.Style = objstyle
Sub Testing()
Dim oTable As Word.Table
Set oTable = Application.ActiveDocument.Tables.Add(Range:=Application.Selection.Range, NumRows:=1, NumColumns:=1)
Debug.Print objTable.PreferredWidthType
End Sub
Public Sub TestingDis_Insert()
Dim oRange As Word.Range
Dim iNoOfSections As Integer
Dim objTable As Word.Table
Dim sngTableWidthPoints As Single
Application.ActiveDocument.PageSetup.DifferentFirstPageHeaderFooter = 0
Set oRange = Application.ActiveDocument.Range
oRange.Collapse (Word.WdCollapseDirection.wdCollapseEnd)
oRange.InsertBreak (Word.WdBreakType.wdSectionBreakNextPage)
'get the total number of sections now in the document
iNoOfSections = Application.ActiveDocument.Sections.Count
'unlink header and footer from the previous section
With Application.ActiveDocument.Sections(iNoOfSections).Headers(WdHeaderFooterIndex.wdHeaderFooterPrimary)
.LinkToPrevious = False
.Range.Delete
End With
With Application.ActiveDocument.Sections(iNoOfSections).Footers(WdHeaderFooterIndex.wdHeaderFooterPrimary)
.LinkToPrevious = False
.Range.Delete
End With
'adjust the bottom margin of this section
With Application.ActiveDocument.Sections(iNoOfSections)
.PageSetup.BottomMargin = Application.CentimetersToPoints(1.52)
End With
'get a range that represents the end of the document
Set objRange = Application.ActiveDocument.Range
objRange.Collapse (WdCollapseDirection.wdCollapseEnd)
' add a table with 1 column and 3 rows
Set oTable = Application.ActiveDocument.Tables.Add(Range:=oRange, NumRows:=3, NumColumns:=1)
sngTableWidthPoints = Application.ActiveDocument.PageSetup.PageWidth - _
(Application.ActiveDocument.PageSetup.LeftMargin + _
Application.ActiveDocument.PageSetup.RightMargin) + 8
With oTable
.PreferredWidthType = wdPreferredWidthPoints
.PreferredWidth = sngTableWidthPoints
' With .Rows
' .VerticalPosition = Word.WdTablePosition.wdTableBottom
' .RelativeVerticalPosition = Word.WdRelativeVerticalPosition.wdRelativeVerticalPositionMargin
' End With
With .Range.Font
.Name = "Expert Sans Regular"
.Size = 8
End With
End With
'get a range that represents the end of the document
Set oRange = Application.ActiveDocument.Range
oRange.Collapse (Word.WdCollapseDirection.wdCollapseEnd)
'selecting the line
oRange.Expand (WdUnits.wdParagraph)
oRange.Font.Name = "Expert Sans Regular"
oRange.Font.Size = 8
oRange.InsertParagraphAfter
oRange.Select
'get a range that represents the end of the document
Set oRange = Application.ActiveDocument.Range
oRange.Collapse (Word.WdCollapseDirection.wdCollapseEnd)
'add a table with 1 column and 1 row
Set oTable = Application.ActiveDocument.Tables.Add(Range:=objRange, NumRows:=1, NumColumns:=1)
With oTable
.PreferredWidthType = wdPreferredWidthPoints
.PreferredWidth = sngTableWidthPoints 'use the same width we calculated above
With .Range.Font
.Name = "Expert Sans Regular"
.Size = 8
End With
End With
End Sub
VBA - Deleting
Deleting from a header
Dim oHeaderRange As Word.Range
Set oHeaderRange = ThisDocument.Sections.Item(1).Headers(wdHeaderFooterPrimary).Range
oHeaderRange.Tables.Item(1).Delete
VBA - Formatting
Selection.Tables(1).Rows
.WrapAroundText = True
.DistanceTop :=
.DistanceBottom:=Application.InchesToPoints(0)
.DistanceLeft:=
.DistanceRight:=
.AllowOverlap:=
.RelativeVerticalPosition
.RelativeHorizontalPosition
.VerticalPosition:=wdFramePosition
.HorizontalPosition:=wdTablePosition or number of points
The HorizontalPosition property is only used when WrapAroundText=True
VBA - Rows
Inserting at the current position
Selection.InsertRowsBelow
Selection.InsertRowsAbove
Selection.InsertRows
objTable.Rows.Add
objTable.Rows.Add(Before:=Selection.Tables(1).Rows(2)
Deleting
Row Heights
Set oTable = ActiveDocument.Tables.Add(Range:=oRange, _
NumRows:=1, _
NumColumns:=2, _
DefaultTableBehavior:=WdDefaultTableBehavior.wdWord8TableBehavior, _
AutoFitBehavior:=WdAutoFitBehavior.wdAutoFitWindow)
oTable.Rows(1).HeightRule = wdRowHeightExactly
oTable.Rows(1).Height = Application.CentimetersToPoints(2.4)
VBA - Columns
Inserting
objTable.Columns.Add(Before:=Selection.Tables(1).Columns(2)
Deleting
Column Widths
Set oTable = ActiveDocument.Tables.Add(Range:=oRange, _
NumRows:=1, _
NumColumns:=2, _
DefaultTableBehavior:=WdDefaultTableBehavior.wdWord8TableBehavior, _
AutoFitBehavior:=WdAutoFitBehavior.wdAutoFitWindow)
oTable.PreferredWidthType = wdPreferredWidthPoints
oTable.Cell(1, 1).Width = Application.CentimetersToPoints(3)
oTable.Cell(1, 2).Width = Application.CentimetersToPoints(13.5)
VBA - Cells
Merging
objCells.Merge
objCell1.Merge(objCell2)
objRange.Cells.Merge
Splitting
objCell.Split(irows, icolumns)
objCells.Split(irows, icolumns[,lmergefirst])
Detect if a cell is empty
Method 1
Uses the basis that an empty cell consists of a paragraph mark followed by Chr(7).
Public Sub CheckTableCells
Dim objCell As Cell
Dim objRow As Row
For Each objRow In Selection.Tables(1).Rows
For Each objCell In objRow.Cells
If objCell.Range.Text = Chr(13) & Chr(7) Then
Call MsgBox("objCell.RowIndex & " " & objCell.ColumnIndex & " is empty"
End If
Next objCell
Next objRow
End Sub
Method 2
Uses a Range variable
Public Sub CheckTableCells
Dim objCell As Cell
Dim objRow As Row
Dim objRange As Range
For Each objRow In Selection.Tables(1).Rows
For Each objCell In objRow.Cells
Set objRange = objCell.Range
'move to the end so the end of cell marker and paragraph marker are not included (only 1 character)
objRange.End = objRange.End - 1
If Len(objRange.Text) = 0 Then
Call MsgBox("objCell.RowIndex & " " & objCell.ColumnIndex & " is empty"
End If
Next objCell
Next objRow
End Sub
© 2026 Better Solutions Limited. All Rights Reserved. © 2026 Better Solutions Limited TopPrev