Microsoft Office Forums - View Single Post

gmaxey · 01-16-2025, 10:28 AM

I discovered this issue the other day when working on a project to build fixed width tables.

We know (or now know) that a table can have up to 63 columns. As proof the following creates a table four inches wide with 63 columns:

Code:

Option Explicit
Dim oRng As Range

Sub Macro1_InsertProofTable()
'This procedure proves that a four inch wide table can contain the maximumn number of columns allowed
'in a Word table.
Dim oTbl As Table
Dim lngIndex As Long
  Set oRng = ActiveDocument.Range
  oRng.Delete
  Set oTbl = oRng.Tables.Add(oRng, 6, 63, , wdAutoFitFixed)
  oTbl.PreferredWidthType = wdPreferredWidthPoints
  oTbl.PreferredWidth = 288 '4 inch
  With oTbl
     For lngIndex = 1 To 6
      .Borders(-lngIndex).LineStyle = wdLineStyleSingle
      .Borders(-lngIndex).LineWidth = 4
      .Borders(-lngIndex).Color = 255
    Next lngIndex
    .TopPadding = 1
    .BottomPadding = 1
    .LeftPadding = 1
    .RightPadding = 1
    .AutoFitBehavior (wdAutoFitFixed)
    oTbl.PreferredWidthType = wdPreferredWidthPoints
    oTbl.PreferredWidth = 288 '360 '5 inch
    .Range.Font.Size = 3
    .Rows.HeightRule = wdRowHeightExactly
    .Rows.Height = 288 / 63
  End With
lbl_Exit:
  Exit Sub
End Sub

Now, given the proof, we should be able to start with a table with less that 63 columns and then add columns up to a total of 63. Not always true (or at least without an anomaly). To demonstrate, lets start with a demo table 4" wide with of 8 columns:

Code:

Option Explicit
Dim oRng As Range
Sub InsertDemoTable()
'This procedure creates a demostration table fixed at four inches wide.
'Column count = 8
Dim oTbl As Table
Dim lngIndex As Long
  Set oRng = ActiveDocument.Range
  oRng.Delete
  Set oTbl = oRng.Tables.Add(oRng, 6, 8, , wdAutoFitFixed)
  oTbl.PreferredWidthType = wdPreferredWidthPoints
  oTbl.PreferredWidth = 288 '4 inch
  With oTbl
     For lngIndex = 1 To 6
      .Borders(-lngIndex).LineStyle = wdLineStyleSingle
      .Borders(-lngIndex).LineWidth = 4
      .Borders(-lngIndex).Color = 255
    Next lngIndex
    .TopPadding = 1
    .BottomPadding = 1
    .LeftPadding = 1
    .RightPadding = 1
    .AutoFitBehavior (wdAutoFitFixed)
    oTbl.PreferredWidthType = wdPreferredWidthPoints
    oTbl.PreferredWidth = 288
    .Range.Font.Size = 3
    .Rows.HeightRule = wdRowHeightExactly
    .Rows.Height = 288 / 30
  End With
lbl_Exit:
  Exit Sub
End Sub

Now, to me at least, it seems that we should be able to run this code which attempts to add 55 additional columns (for a total of 55):

Code:

Sub ShowAnomoly()
Dim oTbl As Table
Dim lngIndex As Long, lngErr As Long
  Set oTbl = ActiveDocument.Tables(1)
  Application.ScreenUpdating = False
  With oTbl
    'A table can contain up to 63 columns.
    'Start adding them one by one keeping the table width fixed and adjusting row height.
    For lngIndex = 1 To 55
      On Error GoTo Err_Handler
      .Columns.Add
      .PreferredWidthType = wdPreferredWidthPoints
      .PreferredWidth = 288
      .Rows.HeightRule = wdRowHeightExactly
      .Rows.Height = 288 / (8 + lngIndex)
    Next
  End With
  Application.ScreenUpdating = True
lbl_Exit:
  MsgBox oTbl.Columns.Count
  Exit Sub
Err_Handler:
  Debug.Print Err.Number & " - " & Err.Description & " adding column " & lngIndex
  Stop 'If the code breaks with a physical stop. I can then continue and the process completes as expected.
  Resume
End Sub

Notice the code errors and I have added a Stop line. If your resume the code, the process will complete and the result will be a table with 63 columns.

Why does the code error? It seems that as the columns are added and despite the code instruction to keep the table width fixed at 288 points the overall table width is expanded with each add until it reaches a limit (the table isn't actually resized until the procedure reaches the end point (or a Stop).

I have tried every possible thing that I know of e.g., DoEvents, code pauses, etc. and I can not find a solution in a single procedure that will behave as that physical "Stop"

As a work around, I have come up with the following which basically adds part of the 55 columns, runs to End Sub, then after a 1 second initiate a second procedure to add the additional columns:

Code:

Sub AnomolyWorkAround()
  'Start with the original Demo table.

  'Step 1  Do part of the process. Run to completion (the refresh occurs), then 1 second later initiate Step 2
  AddColsWAR 30, 8
  Application.OnTime When:=Now + TimeValue("00:00:01"), Name:="modMain.WARStep2"
lbl_Exit:
  Exit Sub
End Sub
Sub WARStep2()
  AddColsWAR
End Sub
Sub AddColsWAR(Optional lngCols As Long = 0, Optional lngBaseCols As Long = 0)
Dim oTbl As Table
Dim lngIndex As Long, lngErr As Long
  'MsgBox "A"
  Set oTbl = ActiveDocument.Tables(1)
  If lngCols = 0 Then lngCols = 63 - oTbl.Columns.Count
  If lngBaseCols = 0 Then lngBaseCols = oTbl.Columns.Count
  Application.ScreenUpdating = False
  With oTbl
    'A table can contain up to 63 columns.
    'Start adding them one by one keeping the table width fixed and adjusting row height.
    For lngIndex = 1 To lngCols
      'On Error GoTo Err_Handler
      .Columns.Add
      .PreferredWidthType = wdPreferredWidthPoints
      .PreferredWidth = 288
      .Rows.HeightRule = wdRowHeightExactly
      .Rows.Height = 288 / (lngBaseCols + lngIndex)
    Next
  End With
  Application.ScreenUpdating = True
lbl_Exit:
  'MsgBox oTbl.Columns.Count
  Exit Sub
'Err_Handler:
  'Debug.Print Err.Number & " - " & Err.Description & " adding column " & lngIndex
  'Stop 'If the code breaks with a physical stop. I can then continue and the process completes as expected.
  'Resume
End Sub

Curious if anyone else has experience anything similar, knows of a better work around.