Adjusting table widths according to page layout in word vba

Question

I'm looking to automate a tedious part of my job with visual basic in Word. I work on long word documents and tables have to be certain widths (6.5 inches [or 468 points] in portrait orientation and 9 inches [or 648 points] in landscape). So far I have

Sub TableResize()

Dim oTbl As Table

    For Each oTbl In ActiveDocument.Tables

        oTbl.AutoFitBehavior wdAutoFitFixed

        With ActiveDocument.PageSetup

            oTbl.PreferredWidthType = wdPreferredWidthPoints

            oTbl.PreferredWidth = 468

            oTbl.Rows.Alignment = wdAlignRowCenter
    
    End With
    
    Next oTbl

End Sub

Which works great to set ALL tables to 6.5 inches and align them to the center, but this of course screws up the tables on pages that are landscape oriented. Can anyone help me to set the table widths according to the page layout?

Thanks, Ben

Answer 1

Sub Demo()
Application.ScreenUpdating = False
Dim Tbl As Table
For Each Tbl In ActiveDocument.Tables
  With Tbl
    .AllowAutoFit = False
    .Rows.Alignment = wdAlignRowCenter
    .PreferredWidthType = wdPreferredWidthPoints
    If .Range.Sections.First.PageSetup.Orientation = wdOrientPortrait Then
      .PreferredWidth = InchesToPoints(6.5)
    Else
      .PreferredWidth = InchesToPoints(9)
    End If
  End With
Next
Application.ScreenUpdating = True
End Sub

Answer 2

If you change your .PreferredWidthType to wdPreferredWidthPercent, its size will be proportional to the page width. You only need to change two lines of your code:

  oTbl.PreferredWidthType = wdPreferredWidthPoints
  oTbl.PreferredWidth = 468

Replace with following:

  oTbl.PreferredWidthType = wdPreferredWidthPercent 
  oTbl.PreferredWidth = 50   ' Change with suitable value

However, instead of 50, you need to work out and change to the value that suits your requirement

Answer 3

While you could test the width of each page and set the table accordingly, this is simpler:

Sub TableResize()
    Dim oTbl As Table
    
    For Each oTbl In ActiveDocument.Tables
        With oTbl
            .AutoFitBehavior wdAutoFitFixed
            .PreferredWidthType = wdPreferredWidthPercent
            .PreferredWidth = 100
            .Rows.Alignment = wdAlignRowCenter
        End With
    Next oTbl
End Sub

I also cleaned up your code a bit.