Необходимо изменить форматирование всех таблиц документа.
Макрос, который делает это для выделенной таблицы, у меня есть, а вот как сделать для всех сразу?
С помощью интернета собрал такое решение, но оно не работает. Происходит ошибка в строке
For Each myRange In tbl.Range. В ошибке написано: не могу такой метод или свойство применить.
Код
Sub FTables()
' FTable Макрос
'
'
Dim myTable As Word.Table
For Each myTable In ActiveDocument.Tables
myTable.PreferredWidthType = wdPreferredWidthPercent 'Выравнивание по ширине
myTable.PreferredWidth = 100 'Размер таблицы в процентах
myTable.TopPadding = CentimetersToPoints(0.1) 'Отступ в ячейке сверху
myTable.BottomPadding = CentimetersToPoints(0.1) 'Отступ в ячейке снизу
myTable.LeftPadding = CentimetersToPoints(0.1) 'Отступ в ячейке слева
myTable.RightPadding = CentimetersToPoints(0.1) 'Отступ в ячейке справа
myTable.Spacing = 0 'Расстояние между ячейками
myTable.AllowPageBreaks = True 'Разрешить перенос на сдедующую страницу
myTable.AllowAutoFit = False 'Разрешить автоподбор по содержимому
myTable.Rows.HeightRule = wdRowHeightAtLeast 'Установить правило высоты строки
myTable.Rows.Height = CentimetersToPoints(0.04) 'Установить высоту строки
FTable myTable
Next myTable
End Sub
Sub FTable(tbl As Table)
Dim myRange
For Each myRange In tbl.Range
myRange.VerticalAlignment = wdCellAlignVerticalTop 'Выравнивание текста по вертикали вверх
myRange.Font.Size = 11 'Размер шрифта в пт
myRange.Font.Name = "Arial" 'Гарнитура шрифта
myRange.ParagraphFormat.LeftIndent = CentimetersToPoints(0) 'Отступ слева
myRange.ParagraphFormat.RightIndent = CentimetersToPoints(0) 'Отступ справа
myRange.ParagraphFormat.SpaceBefore = 0 'Интервал до
myRange.ParagraphFormat.SpaceBeforeAuto = False 'Интервал до автоматически
myRange.ParagraphFormat.SpaceAfter = 0 'Интервал после
myRange.ParagraphFormat.SpaceAfterAuto = False 'Интервал после автоматически
myRange.ParagraphFormat.LineSpacingRule = wdLineSpaceSingle 'Межстрочный интервал - одинарный
myRange.ParagraphFormat.Alignment = wdAlignParagraphCenter 'Выравнивание текста - по центру
myRange.ParagraphFormat.WidowControl = True 'Запрет висячих строк
myRange.ParagraphFormat.KeepWithNext = False 'Не отрывать от следующего
myRange.ParagraphFormat.KeepTogether = False 'Не разрывать абзац
myRange.ParagraphFormat.PageBreakBefore = False 'С новой страницы
myRange.ParagraphFormat.NoLineNumber = False 'Запретить нумерацию строк
myRange.ParagraphFormat.Hyphenation = True 'Запретить автоматичесткий перенос слов
myRange.ParagraphFormat.FirstLineIndent = CentimetersToPoints(0) 'Отступ первой строки
myRange.ParagraphFormat.OutlineLevel = wdOutlineLevelBodyText 'Уровень - основной текст
myRange.ParagraphFormat.CharacterUnitLeftIndent = 0 'Отступ слева
myRange.ParagraphFormat.CharacterUnitRightIndent = 0 'Отступ справа
myRange.ParagraphFormat.CharacterUnitFirstLineIndent = 0 'Первая строка
myRange.ParagraphFormat.LineUnitBefore = 0 'Интервал перед
myRange.ParagraphFormat.LineUnitAfter = 0 'Интервал после
myRange.ParagraphFormat.MirrorIndents = False 'Зеркальные отступы
myRange.ParagraphFormat.TextboxTightWrap = wdTightNone 'Обтекание по контуру
myRange.ParagraphFormat.CollapsedByDefault = False 'Свернуты по умолчанию
Next myRange
End Sub
В процедуре 'FTable' я закомментировал первую строку, т.к. у объекта 'Range' нет члена 'VerticalAlignment'.
Макрос
Sub FTables()
' FTable Макрос
'
'
Dim myTable As Word.Table
For Each myTable In ActiveDocument.Tables
myTable.PreferredWidthType = wdPreferredWidthPercent 'Выравнивание по ширине
myTable.PreferredWidth = 100 'Размер таблицы в процентах
myTable.TopPadding = CentimetersToPoints(0.1) 'Отступ в ячейке сверху
myTable.BottomPadding = CentimetersToPoints(0.1) 'Отступ в ячейке снизу
myTable.LeftPadding = CentimetersToPoints(0.1) 'Отступ в ячейке слева
myTable.RightPadding = CentimetersToPoints(0.1) 'Отступ в ячейке справа
myTable.Spacing = 0 'Расстояние между ячейками
myTable.AllowPageBreaks = True 'Разрешить перенос на сдедующую страницу
myTable.AllowAutoFit = False 'Разрешить автоподбор по содержимому
myTable.Rows.HeightRule = wdRowHeightAtLeast 'Установить правило высоты строки
myTable.Rows.Height = CentimetersToPoints(0.04) 'Установить высоту строки
FTable myTable.Range
Next myTable
End Sub
Sub FTable(myRange As Range)
' myRange.VerticalAlignment = wdCellAlignVerticalTop 'Выравнивание текста по вертикали вверх
myRange.Font.Size = 11 'Размер шрифта в пт
myRange.Font.Name = "Arial" 'Гарнитура шрифта
myRange.ParagraphFormat.LeftIndent = CentimetersToPoints(0) 'Отступ слева
myRange.ParagraphFormat.RightIndent = CentimetersToPoints(0) 'Отступ справа
myRange.ParagraphFormat.SpaceBefore = 0 'Интервал до
myRange.ParagraphFormat.SpaceBeforeAuto = False 'Интервал до автоматически
myRange.ParagraphFormat.SpaceAfter = 0 'Интервал после
myRange.ParagraphFormat.SpaceAfterAuto = False 'Интервал после автоматически
myRange.ParagraphFormat.LineSpacingRule = wdLineSpaceSingle 'Межстрочный интервал - одинарный
myRange.ParagraphFormat.Alignment = wdAlignParagraphCenter 'Выравнивание текста - по центру
myRange.ParagraphFormat.WidowControl = True 'Запрет висячих строк
myRange.ParagraphFormat.KeepWithNext = False 'Не отрывать от следующего
myRange.ParagraphFormat.KeepTogether = False 'Не разрывать абзац
myRange.ParagraphFormat.PageBreakBefore = False 'С новой страницы
myRange.ParagraphFormat.NoLineNumber = False 'Запретить нумерацию строк
myRange.ParagraphFormat.Hyphenation = True 'Запретить автоматичесткий перенос слов
myRange.ParagraphFormat.FirstLineIndent = CentimetersToPoints(0) 'Отступ первой строки
myRange.ParagraphFormat.OutlineLevel = wdOutlineLevelBodyText 'Уровень - основной текст
myRange.ParagraphFormat.CharacterUnitLeftIndent = 0 'Отступ слева
myRange.ParagraphFormat.CharacterUnitRightIndent = 0 'Отступ справа
myRange.ParagraphFormat.CharacterUnitFirstLineIndent = 0 'Первая строка
myRange.ParagraphFormat.LineUnitBefore = 0 'Интервал перед
myRange.ParagraphFormat.LineUnitAfter = 0 'Интервал после
myRange.ParagraphFormat.MirrorIndents = False 'Зеркальные отступы
myRange.ParagraphFormat.TextboxTightWrap = wdTightNone 'Обтекание по контуру
myRange.ParagraphFormat.CollapsedByDefault = False 'Свернуты по умолчанию
End Sub
Администратор, спасибо, очень помогло.
Немного подкрутив код, получил конечный рабочий вариант.
У объекта Range действительно нет члена VerticalAlignment, но есть Cells.VerticalAlignment.
Макрос
Sub FTables()
' FTable Макрос
'
'
Dim myTable As Word.Table
For Each myTable In ActiveDocument.Tables
myTable.PreferredWidthType = wdPreferredWidthPercent 'Выравнивание по ширине
myTable.PreferredWidth = 100 'Размер таблицы в процентах
myTable.TopPadding = CentimetersToPoints(0.1) 'Отступ в ячейке сверху
myTable.BottomPadding = CentimetersToPoints(0.1) 'Отступ в ячейке снизу
myTable.LeftPadding = CentimetersToPoints(0.1) 'Отступ в ячейке слева
myTable.RightPadding = CentimetersToPoints(0.1) 'Отступ в ячейке справа
myTable.Spacing = 0 'Расстояние между ячейками
myTable.AllowPageBreaks = True 'Разрешить перенос на сдедующую страницу
myTable.AllowAutoFit = False 'Разрешить автоподбор по содержимому
myTable.Rows.HeightRule = wdRowHeightAtLeast 'Установить правило высоты строки
myTable.Rows.Height = CentimetersToPoints(0.04) 'Установить высоту строки
FTable myTable.Range
Next myTable
End Sub
Sub FTable(myRange As Range)
With myRange
.Cells.VerticalAlignment = wdCellAlignVerticalTop 'Выравнивание текста по вертикали вверх
.Font.Size = 11 'Размер шрифта в пт
.Font.Name = "Arial" 'Гарнитура шрифта
End With
With myRange.ParagraphFormat
.LeftIndent = CentimetersToPoints(0) 'Отступ слева
.RightIndent = CentimetersToPoints(0) 'Отступ справа
.SpaceBefore = 0 'Интервал до
.SpaceBeforeAuto = False 'Интервал до автоматически
.SpaceAfter = 0 'Интервал после
.SpaceAfterAuto = False 'Интервал после автоматически
.LineSpacingRule = wdLineSpaceSingle 'Межстрочный интервал - одинарный
.Alignment = wdAlignParagraphCenter 'Выравнивание текста - по центру
.WidowControl = True 'Запрет висячих строк
.KeepWithNext = False 'Не отрывать от следующего
.KeepTogether = False 'Не разрывать абзац
.PageBreakBefore = False 'С новой страницы
.NoLineNumber = False 'Запретить нумерацию строк
.Hyphenation = True 'Запретить автоматичесткий перенос слов
.FirstLineIndent = CentimetersToPoints(0) 'Отступ первой строки
.OutlineLevel = wdOutlineLevelBodyText 'Уровень - основной текст
.CharacterUnitLeftIndent = 0 'Отступ слева
.CharacterUnitRightIndent = 0 'Отступ справа
.CharacterUnitFirstLineIndent = 0 'Первая строка
.LineUnitBefore = 0 'Интервал перед
.LineUnitAfter = 0 'Интервал после
.MirrorIndents = False 'Зеркальные отступы
.TextboxTightWrap = wdTightNone 'Обтекание по контуру
.CollapsedByDefault = False 'Свернуты по умолчанию
End With
End Sub