Set table column widths in Word macro VBA

Question

1. What I'm Trying To Do

I have a folder with 84 Word documents (.docx). Every document contains a table of identical layout (some of the documents span across 2 pages). However, the column widths are not always the same.

I want to make all the table column widths identical at 2 inches, so I can subsequently save all the files as PDF, and prepare them for use in another process which I will not elaborate on.

2. My Current Approach

I've got a Word VBA macro that runs a script (below) over all .docx files in a folder, based on a user-prompted file path. This part works - there's no problem.

The problem

However, when my script attempts to set all the columns in the document's tables to the same width, this doesn't work. It only works, in the example document shown here, on the first 3 columns.

Illustrating the problem with screenshots

Figure 1 (above): This is what the original table looks like in the Word document.

Figure 2 (above): This is what the table looks like after running my macro. In this example, I ran the macro to set all column widths to 1.5 (InchesToPoints(1.5)). You can see that only the first 3 columns are adjusted, but columns 4-7 are unmodified.

Figure 3 (above): This is what I expected the table to look like after running my macro to set all columns to 1.5 inches in width.

Here's a link to the original document: https://www.dropbox.com/s/cm0fqr6o7xgavpv/1-Accounting-Standards.docx?dl=0

Testing on another file

I tested the macro on another file I created, where I inserted 3 tables.

Figure 4 (above): I created a new file with 3 tables, all with different column widths.

Figure 5 (above): Running the macro with this test file in the same folder as the example document previously, shows that the macro works, and adjusts the columns in all tables to the specified width.

3. My Question

What's going on here? Why isn't SetTableWidths working as expected?

I'm guessing that it's maybe because the original table in the original word document contains merged cells, otherwise why would the script not work on columns 4-7?

Any help would be greatly appreciated.

4. Word VBA Macro

Sub RunMacroOnAllFilesInFolder()
    Dim flpath As String, fl As String
    flpath = InputBox("Please enter the path to the folder you want to run the macro on.")
    If flpath = "" Then Exit Sub

    If Right(flpath, 1) <> Application.PathSeparator Then flpath = flpath & Application.PathSeparator
    fl = Dir(flpath & "*.docx")
    Application.ScreenUpdating = False
    Do Until fl = ""
        MyMacro flpath, fl
        fl = Dir
    Loop
End Sub

Sub MyMacro(flpath As String, fl As String)
    Dim doc As Document
    Set doc = Documents.Open(flpath & fl)
    'Your code below

    SetTableWidths doc
    DeleteAllHeadersFooters doc

    'your code above
    doc.Save
    doc.Close SaveChanges:=wdSaveChanges
End Sub

Sub SetTableWidths(doc As Document)
    Dim t As Table
    For Each t In doc.Tables
        t.Columns.Width = InchesToPoints(2)
    Next t
End Sub

Sub DeleteAllHeadersFooters(doc As Document)

  Dim sec As Section
  Dim hd_ft As HeaderFooter

  For Each sec In ActiveDocument.Sections
    For Each hd_ft In sec.Headers
      hd_ft.Range.Delete
    Next
    For Each hd_ft In sec.Footers
      hd_ft.Range.Delete
    Next
  Next sec

End Sub

5. Credit & Disclaimers

I didn't write the VBA macros. I got them online at these two places:

• https://wordribbon.tips.net/T011693_Setting_Consistent_Column_Widths_in_Multiple_Tables
• https://www.quora.com/How-do-I-automatically-run-a-macro-on-all-Word-files-docx-in-a-folder
• http://vba.relief.jp/word-macro-delete-all-headers-and-footers-active-document/

The example documents shown here are property of the Singapore government: http://www.skillsfuture.sg/skills-framework

Answer 1

I managed to fix the issue on my own, based on further experimentation.

I suspected that the issue was related to the merged cells at the top of the table, and while I am not sure exactly what's going on in the internal code that affects setting t.Columns.Width, I found that making the same number of columns in all rows of the table fixes the unintended behavior.

I split the merged cells in the first 3 rows of the table (see the Question for a screenshot of what that looks like).

Sub SplitMergedColumns(t As Table)
    'Merged columns causes issues for setting column width. This splits merged column cells.
    Dim a As Cell, b As Cell, c As Cell
    Set a = t.Cell(1, 2)
    Set b = t.Cell(2, 2)
    Set c = t.Cell(3, 2)
    a.Split NumRows:=1, NumColumns:=6
    b.Split NumRows:=1, NumColumns:=6
    c.Split NumRows:=1, NumColumns:=6
End Sub

Then, running the above-mentioned Sub SetTableWidths works as expected. The result is like this screenshot:

Answer 2

Try something based on:

Sub SetTableWidths(Doc As Document)
Dim Tbl As Table, c As Long, sWdth As Single
sWdth = InchesToPoints(14)
For Each Tbl In Doc.Tables
  With Tbl
    .PreferredWidthType = wdPreferredWidthPoints
    .PreferredWidth = sWdth
    sWdth = sWdth / 7
    With .Range
      For c = 1 To 5 Step 2
        .Cells(c).Width = sWdth
      Next
      For c = 2 To 6 Step 2
        .Cells(c).Width = sWdth * 6
      Next
      For c = 7 To .Cells.Count
        .Cells(c).Width = sWdth
      Next
    End With
  End With
Next
End Sub