Задать определенную ширину столбцов

[Посетитель 26.04.2023]

Есть много разных документов с таблицами. Все таблицы одинаковые. В каждой таблице по 11 столбцов. Как при помощи макроса сделать ширину 1 столбца 1.5 см, второго, 1,5 см, 3 -3.5 см, 4 -1 см и так далее. Таблица располагается на листе формата А4, альбомное расположение, должна занимать всю страницу.

Спойлер

Sub Test3()

With Selection.Tables(1)
     .PreferredWidthType = wdPreferredWidthPoints
     .PreferredWidth = CentimetersToPoints(27)
     .Columns(1).PreferredWidth = CentimetersToPoints(1.5)
     .Columns(2).PreferredWidth = CentimetersToPoints(1.5)
     .Columns(3).PreferredWidth = CentimetersToPoints(3.5)
     .Columns(4).PreferredWidth = CentimetersToPoints(1)
     .Columns(5).PreferredWidth = CentimetersToPoints(1)
     .Columns(6).PreferredWidth = CentimetersToPoints(3)
     .Columns(7).PreferredWidth = CentimetersToPoints(5.25)
     .Columns(8).PreferredWidth = CentimetersToPoints(1.5)
     .Columns(9).PreferredWidth = CentimetersToPoints(1.5)
     .Columns(10).PreferredWidth = CentimetersToPoints(2)
 End With
 
 End Sub

[свернуть]

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

Сейчас ваш макрос, который вы показали в первом сообщении, делает правильные ширины столбцов в таблице?

[Посетитель 26.04.2023]

Этот макрос не работает. Ширина столбцов не изменяется.

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

Написал вам два письма на почту с заголовком "Письмо с Форума по VBA, Excel и Word". Написал именно на почту, а не на форум.

Этот макрос работает:?

Макрос

Sub Test3()

With Selection.Tables(1)
     .PreferredWidthType = wdPreferredWidthPoints
     .Columns(1).PreferredWidth = CentimetersToPoints(1.5)
     .Columns(2).PreferredWidth = CentimetersToPoints(1.5)
     .Columns(3).PreferredWidth = CentimetersToPoints(3.5)
     .Columns(4).PreferredWidth = CentimetersToPoints(1)
     .Columns(5).PreferredWidth = CentimetersToPoints(1)
     .Columns(6).PreferredWidth = CentimetersToPoints(3)
     .Columns(7).PreferredWidth = CentimetersToPoints(5.25)
     .Columns(8).PreferredWidth = CentimetersToPoints(1.5)
     .Columns(9).PreferredWidth = CentimetersToPoints(1.5)
     .Columns(10).PreferredWidth = CentimetersToPoints(2)
 End With
 
 End Sub

[свернуть]

[Посетитель 26.04.2023]

нет, не работает.

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

Происходит ошибка? Выложите скриншот ошибки.

[Посетитель 26.04.2023]

Если создать пустую таблицу, то работает. Именно на моей таблице не работает.

[Посетитель 26.04.2023]

разобралась. В моей таблице были объединенные ячейки. Я их удалила и все заработало.