Тема: Таблицы и колонтитулы
Перед тем, как написать сюда, попытатался найти решение в инете, но ничего не смог найти.
А вопрос вот в чем - написал две процедуры (по мотивам макросов, приведенных в книге уважаемого админа), которые изменяют ширину всех (или одной) таблиц по ширине текста (у Антона было - по ширине окна, так что есть небольшая разница). И отладил эти макросы для документов с несколькими разделами, в которых ориентация страницы и форматы бумаги могут быть разными. Все работает. Осталось сделать то же самое с таблицами в колонтитуле. Вот тут и наступил ступор. Может кто сталкивался с такой проблемой? Знаю (из других страниц в инете), что как минимум еще один зарегистрированный тут пользователь хотел бы узнать решение данной задачи:)
Привожу код основных процедур:
Макрос для всех таблиц в основном тексте:
Sub AllTablesAutoFitTextWidth()
'Выравнивание всех таблиц по ширине текста
' Написан по мотивам макроса А.Кокина из книги
' "Word 2003/2007. Народные советы"
Dim arTable As Table ' определение таблицы как объекта "Таблица"
Dim arCurrentDoc As Document 'определение документа как объект "Документ"
Dim arPageWidth As Single ' Ширина страниц
Dim arLeftMargin As Single 'Отступ текста от левого края страницы
Dim arRightMargin As Single ' Отступ текста от правого края страницы
Dim arTableWidth As Single ' Ширина таблицы
Dim arIndexOfSections As Integer
Dim arMeter As Integer
Dim arStoryRangNumber As Integer
arIndexOfSections = ActiveDocument.Sections.Count
Set arCurrentDoc = ActiveDocument ' присвоение переменной имени текущего документа
For arMeter = 1 To arIndexOfSections ' от первого до последнего раздела
arPageWidth = arCurrentDoc.Sections(arMeter).PageSetup.PageWidth ' присвоение переменной текущей ширины страницы
arLeftMargin = arCurrentDoc.Sections(arMeter).PageSetup.LeftMargin ' присвоение переменной значения отступа текста от левого края страницы
arRightMargin = arCurrentDoc.Sections(arMeter).PageSetup.RightMargin ' присвоение переменной значения отступа текста от правого края страницы
arTableWidth = arPageWidth - (arLeftMargin + arRightMargin) 'Расчет ширины таблицы исходя из текущих значений переменных
For Each arTable In ActiveDocument.Sections(arMeter).Range.Tables ' для каждой таблицы в выделенном разделе
arTable.Rows.Alignment = wdAlignRowCenter 'выравнивание таблицы по центру страницы
arTable.Rows.LeftIndent = CentimetersToPoints(0) 'измерение ширины в сантиметрах
arTable.PreferredWidthType = wdPreferredWidthPoints 'тип автоподбора ширины таблицы
arTable.PreferredWidth = arTableWidth 'собственно задание таблице ее новой ширины
Next arTable ' работа со следующей таблицей
Next arMeter
End Sub
Макрос для отдельно выбранной таблице (курсор должен быть внутри таблицы):
Sub SingleTableAutoFitTextWidth()
'Выравнивание выбранной таблицы по ширине текста
' Написан по мотивам макроса А.Кокина из книги
' "Word 2003/2007. Народные советы"
Dim arTable As Table
Dim arCurrentDoc As Document
Dim arPageWidth As Single
Dim arLeftMargin As Single
Dim arRightMargin As Single
Dim arTableWidth As Single
Set arCurrentDoc = ActiveDocument
arLeftMargin = 0
arRightMargin = 0
With Selection
Set arTable = .Tables(1)
arPageWidth = .Range.Sections.PageSetup.PageWidth
arLeftMargin = .Range.Sections.PageSetup.LeftMargin
arRightMargin = .Range.Sections.PageSetup.RightMargin
End With
arTableWidth = arPageWidth - (arLeftMargin + arRightMargin)
arTable.Rows.Alignment = wdAlignRowCenter
arTable.Rows.LeftIndent = CentimetersToPoints(0)
arTable.PreferredWidthType = wdPreferredWidthPoints
arTable.PreferredWidth = arTableWidth
End Sub
Можно ли внести изменения в приведенный текст, чтобы он работал и с колонтитулами? или нужно для колонтитулов нужно свои две процедуры писать?
Проблема в том, что программно я пока не знаю как выбрать таблицу (таблицы могут быть и в верхнем, и в нижнем колонтитуле, разделов с разной ориентацией, а значит и различных колонтитулов может быть много).
Подсознательно кажется, что нужно работать с цепочками (как в книге внешняя ссылка), но пока не смог разобраться, как эти цепочки применить к таблицам:(
Прошу посильной помощи!
ps. Макрорекордером записал вот такой вот код (для трех разделов):
Sub Макрос1()
'
' Макрос1 Макрос
'
If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
ActiveWindow.Panes(2).Close
End If
If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
ActivePane.View.Type = wdOutlineView Then
ActiveWindow.ActivePane.View.Type = wdPrintView
End If
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
Selection.Tables(1).Select
Selection.Tables(1).PreferredWidthType = wdPreferredWidthPoints
Selection.Tables(1).PreferredWidth = CentimetersToPoints(17)
ActiveWindow.ActivePane.View.NextHeaderFooter
Selection.Tables(1).Select
Selection.Tables(1).Rows.Alignment = wdAlignRowCenter
Selection.Tables(1).Rows.LeftIndent = CentimetersToPoints(0)
Selection.Tables(1).PreferredWidthType = wdPreferredWidthPoints
Selection.Tables(1).PreferredWidth = CentimetersToPoints(17)
ActiveWindow.ActivePane.View.NextHeaderFooter
Selection.Tables(1).Select
Selection.Tables(1).Rows.Alignment = wdAlignRowCenter
Selection.Tables(1).Rows.LeftIndent = CentimetersToPoints(0)
Selection.Tables(1).PreferredWidthType = wdPreferredWidthPoints
Selection.Tables(1).PreferredWidth = CentimetersToPoints(17)
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
End Sub
его конечно можно переделать нормально, но суть не в этом, а в том, что он работает, когда в колонтитуле сверху вниз идут сначала таблица, а потом знак абзаца. Если знак абзаца стоит перед таблицей - естественно, данный макрос не работает, отсюда и вопрос, приведенный выше, как выбрать программно таблицу в колонтитулах..