Выделить все таблицы в документе

[shadowbeast]

Добрый вечер!
Никак не могу собрать макрос.
Есть файл, в нём много таблиц. Подскажите пожалуйста, как выделить все таблицы в документе, а текст между ними оставить невыделенным?

Table.Selection Tables ?

[Sasha_Smirnov]

Только вручную. (Ясно, что это не метод.)

Очень похожую — обратную — задачу недавно (в конце января) здесь решали:
http://www.programmersforum.ru/showthread.php?t=36501.

И вот там как-то обошлись без хитроумного выделения. В конечном счёте важно, что вам надо с этими (пока не выделенными) таблицами сделать.

[shadowbeast]

Мне нужно ко всем таблицам в документе применить единое форматирование.
Сейчас я это делаю выделяя каждую таблицу вручную и используя макрос - форматирования таблицы.
Но таблиц иногда бывает очень много - до 150 листов. Напряжно)

Потому надо в начало макроса форматирования добавить строки:
"выделить все таблицы в документе")))

[viter.alex]

Сообщение от shadowbeast

Мне нужно ко всем таблицам в документе применить единое форматирование.
Сейчас я это делаю выделяя каждую таблицу вручную и используя макрос - форматирования таблицы.
Но таблиц иногда бывает очень много - до 150 листов. Напряжно)

Потому надо в начало макроса форматирования добавить строки:
"выделить все таблицы в документе")))

Привет, shadowbeast! Только так.

  Dim oTable As Table
  For Each oTable In ThisDocument.Tables
    'пишем нужное форматирование
  Next

[shadowbeast]

Привет, viter.alex!

Спасибо, так и сделал.) Посмотрел на те макросы, что ты мне написал по анализу ячеек, разобрался как работает)
Всё отлично!

Только почему-то объявление в одном из случаев не сработало, а потом получилось)

[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

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

[Ципихович Эндрю]

1. код выложите с тегами
2. мне кажется лучше сначала всё сделать для всего одинаково, а затем занятся первым столбцом