Thread: [Solved] Auto fit tables to page
View Single Post
 
Old 07-20-2011, 01:12 AM
macropod's Avatar
macropod macropod is offline Windows 7 64bit Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,963
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

Hi boutells,

Nothing built-in, though the default width fits the page margins (plus whatever internal cell margins the table has). However, you could insert the table, then format its height with a macro. The following macro fits all selected tables to the height of the page in the section in which they appear. Whether the tables actually print that way depends on whether there is anything else on the same pages:
Code:
Sub TableFit()
Application.ScreenUpdating = False
Dim oTopMargin As Single, oBottomMargin As Single, oBottomLine As Single
Dim oPageHeight As Single, oPrintHeight As Single, oRowHeight As Single
Dim oTable, oCell As Cell, i As Integer
If Selection.Tables.Count = 0 Then Exit Sub
For i = 1 To Selection.Tables.Count
  oTable = Selection.Tables(i)
  oBottomLine = 0
  With oTable
    For Each oCell In oTable.Rows(oTable.Rows.Count).Cells
      If .Borders(wdBorderBottom).LineWidth > oBottomLine Then _
        oBottomLine = .Borders(wdBorderBottom).LineWidth
    Next
    With .PageSetup
      oTopMargin = .TopMargin
      oBottomMargin = .BottomMargin
      oPageHeight = .PageHeight
    End With
    oPrintHeight = oPageHeight - oTopMargin - oBottomMargin - oBottomLine / 8 - 1
    oRowHeight = oPrintHeight / .Rows.Count
    With .Rows
      .Height = oRowHeight
      .HeightRule = wdRowHeightExactly
    End With
  End With
Next
Application.ScreenUpdating = True
End Sub
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote