How can I resize a table to fit the page's width?

Article contributed by Daryl Lucas, Dave Rado and Suzanne S. Barnhill

Word 2000

In Word 2000 you can select Table + Properties, click on the “preferred width” checkbox; where it says “Measure in”, change it to “percent”, and in the width spinbox, type 100%. The relative column widths are preserved in the resized table.

Or if you want to do it programmatically, you can use:

Selection.Tables(1).PreferredWidthType = wdPreferredWidthPercent
Selection.Tables(1).PreferredWidth = 100

Word 97

In Word 97, you can select the entire table, and on the Column tab of Table | Cell Height and Width, type "a" and press the down arrow. The box will fill with the word “Auto”; OK out, and the table is resized to the margin width. Unfortunately (unlike Word 2000), the columns in the resized table are all equal widths.

Alternatively, if you click in any cell (with nothing selected) and follow the same procedure, the column which the insertion point is in will be resized so that the table fits the page margins – without the other column widths being affected.

If you want to preserve the relative column widths when you resize the table, (as one generally does), you'll need a macro to do the job:

Sub MakeTableFitPageSize()

Dim myTable As Table
Dim OriginalRange As Range
Dim oRow As Row
Dim oCell As Cell
Dim UsableWidth As Single
Dim TableWidth As Single
Dim CellNo As Long

If Selection.Tables.Count = 0 Then
    MsgBox "Please put your cursor inside a table and try again", vbInformation
    Exit Sub
End If

Application.ScreenUpdating = False
System.Cursor = wdCursorWait

Set OriginalRange = Selection.Range
Set myTable = Selection.Tables(1)

myTable.Rows.SetLeftIndent _
        LeftIndent:=0, RulerStyle:=wdAdjustNone

'Calculate usable width of page

With ActiveDocument.PageSetup
    UsableWidth = .PageWidth - .LeftMargin - .RightMargin
End With

'Calculate width of top row, on assumption this will be
'the same as table width

On Error Resume Next

For CellNo = 1 To myTable.Rows(1).Cells.Count

    If Err = 5991 Then
        MsgBox "This macro doesn't work with tables that have vertically merged cells", _
                vbInformation
        GoTo CleanUp
    Else If Err Then
        MsgBox Err.Description, vbInformation
        GoTo CleanUp
    End If

    TableWidth = TableWidth + myTable.Rows(1).Cells(CellNo).Width
Next CellNo

On Error Goto 0

'Calculate and assign width of each cell in each row, such that the cell width relative
'to the table's width stays the same as before. Do it for each row individually rather than
'for a column at a time- otherwise the macro won't work
'if any of the rows contain horizontally merged cells

For Each oRow In myTable.Rows

    For Each oCell In oRow.Cells
        oCell.Width = (oCell.Width) * (UsableWidth / TableWidth)
    Next oCell

Next oRow

OriginalRange.Select

Cleanup:
     'Clear variables from memory
     Set myTable = Nothing
     Set OriginalRange = Nothing
     Set oRow = Nothing
     Set oCell = Nothing
     UsableWidth = 0
     TableWidth = 0
     CellNo = 0

     System.Cursor = wdCursorNormal
     Application.ScreenUpdating = True

End Sub