Задать ширину столбцов таблицы в макросе Word VBA

Question

1. Что я пытаюсь сделать

У меня есть папка с 84 документами Word (.docx). Каждый документ содержит таблицу одинакового формата (некоторые документы занимают 2 страницы). Однако ширина столбцов не всегда одинакова.

Я хочу, чтобы все ширины столбцов таблицы были одинаковыми в 2 дюйма, чтобы впоследствии я мог сохранить все файлы в формате PDF и подготовить их для использования в другом процессе, который я не буду описывать.

2. Мой текущий подход

У меня есть макрос Word VBA, который запускает сценарий (ниже) для всех файлов .docx в папке на основе пути к файлу, предложенному пользователем. Эта часть работает - нет проблем.

Проблема

Однако, когда мой скрипт пытается установить одинаковую ширину всех столбцов в таблицах документа, это не работает. Это работает только в примере документа, показанном здесь, в первых 3 столбцах.

Иллюстрирование проблемы со скриншотами

Рисунок 1 (выше): Вот как выглядит исходная таблица в документе Word.

Рисунок 2 (выше): Вот как выглядит таблица после запуска моего макроса. В этом примере я запустил макрос, чтобы установить ширину всех столбцов на 1,5 (InchesToPoints(1.5)). Вы можете видеть, что корректируются только первые 3 столбца, но столбцы 4-7 не изменены.

Рисунок 3 (выше): это то, что я ожидал, что таблица будет выглядеть после запуска моего макроса, чтобы установить для всех столбцов ширину 1,5 дюйма.

Вот ссылка на оригинальный документ: https://www.dropbox.com/s/cm0fqr6o7xgavpv/1-Accounting-Standards.docx?dl=0

Тестирование на другом файле

Я протестировал макрос в другом созданном мной файле, в который вставил 3 таблицы.

Рисунок 4 (выше): я создал новый файл с 3 таблицами, все с различной шириной столбца.

Рисунок 5 (выше): Запуск макроса с этим тестовым файлом в той же папке, что и в предыдущем примере, показывает, что макрос работает, и настраивает столбцы во всех таблицах на указанную ширину.

3. Мой вопрос

Что здесь происходит? Почему SetTableWidths не работает должным образом?

Я предполагаю, что это может быть потому, что исходная таблица в оригинальном текстовом документе содержит объединенные ячейки, в противном случае, почему скрипт не будет работать со столбцами 4-7?

Любая помощь будет принята с благодарностью.

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. Кредит & Отказ от ответственности

Я не писал макросы VBA. Я получил их онлайн в этих двух местах:

• 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/

Приведенные здесь примеры документов являются собственностью правительства Сингапура: http://www.skillsfuture.sg/skills-framework

Answer 1

Мне удалось решить проблему самостоятельно, основываясь на дальнейших экспериментах.

Я подозревал, что проблема была связана со слитыми ячейками в верхней части таблицы, и хотя я не уверен, что именно происходит во внутреннем коде, который влияет на настройку t.Columns.Width, я обнаружил, что создание того же числа столбцы во всех строках таблицы исправляют непреднамеренное поведение.

Я разделил объединенные ячейки в первых 3 строках таблицы (см. Вопрос о том, как это выглядит).

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

Затем, запуск вышеупомянутого Sub SetTableWidths работает как положено. Результат похож на этот скриншот:

Answer 2

Попробуйте что-нибудь на основе:

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