Полное форматирование всех таблиц в документе чохом

[Vera111]

Доброе время суток!
Прошу помочь. Я не программист вообще, но уверенный пользователь. Могу очень уверенно переписать чужой код как обезьяна и немножко переделать его под себя.
Написала, перелопатив гору макросов , код, чтобы форматировать все таблицы в документе:

Sub Table()

On Error Resume Next

Dim myTable As Table
Dim myCell As Cell
Dim myRange As Range
Dim с As Integer 'Подсчёт количества столбцов в таблице
Dim i As Long

Application.ScreenUpdating = False 'Запрет обновления экрана
For Each myTable In ActiveDocument.Tables




' Выровнять все столбцы по центру
'Обрабатываем ячейки во всех столбцах кроме первого
'Перебор всех ячеек
c = myTable.Columns.Count
For i = 2 To c
myTable.Columns(i).Select
Selection.Find.ClearFormatting
With Selection
For Each myCell In .Cells
myCell.Range.ParagraphFormat.Alignm ent = wdAlignParagraphCenter
myCell.Range.Cells.VerticalAlignmen t = wdCellAlignVerticalCenter
Next myCell
End With
Next i

' Применить ко всем таблицам одинаковый стиль
myTable.Style = ActiveDocument.Styles("Средний список 2 - Акцент 2")
myTable.Rows.Alignment = wdAlignRowCenter
myTable.AutoFitBehavior wdAutoFitWindow
myTable.Rows.HeightRule = wdRowHeightAuto
myTable.Rows.HeightRule = wdRowHeightAtLeast
myTable.Rows.WrapAroundText = False
myTable.PreferredWidthType = wdPreferredWidthPercent
myTable.PreferredWidth = 99
myTable.Range.Font.Size = 9
myTable.Rows.AllowBreakAcrossPages = False


With myTable.Range
.Find.ClearFormatting
.Find.Text = "^p" 'Ищем вхождения переводов строк и удаляем их
.Find.Replacement.Text = ""
.Find.Forward = True
.Find.Execute Replace:=wdReplaceAll
For Each myCell In .Cells
Set myRange = myCell.Range
myRange.MoveEnd Unit:=wdCharacter, Count:=-1
myCell.Range.Text = Trim(myRange.Text) 'Убираем пробелы
myCell.Range.ParagraphFormat.LeftIn dent = CentimetersToPoints(0)
myCell.Range.ParagraphFormat.FirstL ineIndent = 0
Next myCell
End With


With myTable.Rows(1)
.HeadingFormat = True 'Установка заголовков для 1-х строк таблиц
.HeightRule = wdRowHeightAuto 'Установка автовысоты первых строк
End With
With myTable.Rows(1)
For Each myCell In .Cells
myCell.Range.ParagraphFormat.Alignm ent = wdAlignParagraphCenter
myCell.Range.Cells.VerticalAlignmen t = wdCellAlignVerticalCenter
myCell.Range.ParagraphFormat.KeepWi thNext = True
Next myCell
End With

With myTable.Range
myTable.Select
Selection.Cells.DistributeWidth
End With
If Err.Number <> 0 Then Err.Clear
Next
Application.ScreenUpdating = True 'Разрешаем обновление экрана
End Sub

Меня всё устраивает. Но есть одна загвоздка.
Вот это кусок кода делает ширину всех столбцов одинаковой.

With myTable.Range
myTable.Select
Selection.Cells.DistributeWidth
End With

А мне надо выровнять по ширине все столбцы, кроме первого. И с этим я не могу справиться. Ещё раз повторяю - не программист я, может, кто-нибудь подскажет, как исправить эту мелочь и ошибки во всём коде исправит?
Спасибо заранее.

[OlegVE]

Здравствуйте
Попробуйте заменить Ваш кусочек кода

With myTable.Range
myTable.Select
Selection.Cells.DistributeWidth
End With

на следующий

 With ActiveDocument
       Set myRange = .Range(myTable.Rows(1).Cells(2).Range.Start, myTable.Rows(1).Cells(c).Range.End)

       myRange.Select
       Selection.Columns.DistributeWidth
 End With

До свидания

[Vera111]

Спасибо, спасибо большое! Получилось! Свершилось!
Теперь одним нажатием на кнопочку у меня документ, количество таблиц в котором может достигать 60 штук, приводит все таблицы к одному виду. Очень хорошо!

[OlegVE]

Всегда пожалуйста