Word VBA Макросы: Столбцы равной ширины по самому широкому

Автор auto-teacher, 04 октября 2017, 02:43

auto-teacher

Прошу подсказать напрямую или послать в похожую тему.

В Word 2013 cоздается таблица с параметрами – автоподбор по содержимому.
Ячейки таблицы заполняются словами разной длины, то есть, ячейки становятся разной ширины.
Если даю команду "выровнять таблицу по ширине страницы", а потом даю команду "равные столбцы", то столбцы получаются равными, но таблица на всю ширину страницы.
Если же столбцы остаются выровненными по содержимому, а я даю команду "равные столбцы", то таблица остается шириной по содержимому, но увеличивается высота строк.
А я хочу, чтобы она выровнялась по ширине самого широкого столбца, но при этом не по ширине страницы (потому что таблица поуже страницы).

Как макросом выровнять все столбцы по ширине самого широкого?

Я делаю вручную так:
1. Выровнять по содержимому.
2. Копирую с ленты ширину самого широкого столбца (в см).
3. Выделяю другие столбцы.
4. На ленте ставлю для них размер самого широкого (в см).

Администратор

Макрос работает с первой таблицей в файле.

Макрос
Sub макрос()
   
    Dim tbl As Table, max As Single, j As Long
   
    '1. Отключение монитора (может это ускорит макрос и чтобы не мерцало).
    Application.ScreenUpdating = False
    '2. Присваиваем таблице имя "tbl". Затем в коде будем обращаться к таблице по имени "tbl".
        ' Так удобнее читать и писать код.
    Set tbl = ActiveDocument.Tables(1)
    '3. Вкладка "Макет" - группа "Размер ячейки" - Автоподбор - Автоподобор по содержимому.
    tbl.AutoFitBehavior wdAutoFitContent
    '4. Обновление монитора, иначе ширина столбцов не устанавливается.
    Application.ScreenRefresh
    '5. Поиск самой большой ширины столбца.
    For j = 1 To tbl.Columns.Count
        If tbl.Columns(j).Width > max Then
            max = tbl.Columns(j).Width
        End If
    Next j
    '6. Делаем у всех столбцов одинаковую ширину по самому широкому столбцу.
    tbl.Columns.Width = max
    '7. Вкл. монитора.
    Application.ScreenUpdating = True
   
End Sub
[свернуть]

Если нужно работать с таблицей, в которой курсор, то пункт 2 такой:
    '2. Присваиваем таблице имя "tbl". Затем в коде будем обращаться к таблице по имени "tbl".
        ' Так удобнее читать и писать код.
    Set tbl = Selection.Tables(1)

auto-teacher

С сонными глазами проверил: действовать действует, но все равно я должен алгоритм, видимо, по-другому изложить. Еще есть условия, которые должны выполняться, чтобы не было ошибок.