Макросы для обработки документов выставки

У разных пользователей программы возникают различные пожелания к тому, какими должны быть выставочные документы выставки. Совместить эти пожелания невозможно, поэтому для удовлетворения просьб всех пользователей я создал несколько вордовых макросов, которые обрабатывают созданные программой выставочные документы. В зависимости от того, что хочет конкретный пользователь он должен воспользоваться частью из этих макросов. Сначала опишу сами макросы.
Макросы, предназначенные для обработки каталога выставки:
1. oglavlenie - макрос для создания оглавления к уже сформированному, отредактированному и окончательно отформатированному каталогу выставки. Этот макрос следует запускать когда документ уже никак не будет меняться и на том компьютере, на котором вы собираетесь печатать каталог. Иначе оглавление может слегка не соответствовать разбивке на страницы в каталоге.
2. №Род_Клеймо - макрос для объединения в каталоге строк с номером родословной и клеймом.
3. ОТЕЦ_МАТЬ - макрос для объединения в каталоге строк с отцом и матерью.
4. ЗАВ_ВЛАД - макрос для объединения в каталоге строк с заводчиком и владельцем.

Макрос, предназначенный для обработки дипломов выставки, экспонентских листов, ринговых ведомостей, отчетов судей
Во всех перечисленных документах ФИО экспертов проставлены в колонтитуле. Поэтому изначально на весь документ туда можно внести только одного эксперта. Для того, чтобы в каждой породе можно было проставить своего эксперта создан макрос РазрывСвязьКолонт. После запуска этого макроса в каждой породе в нижнем колонтитуле один раз вбивается соответствующий этой породе эксперт. Запуск макроса РазрывСвязьКолонт в дипломах выставки надо производить в самый последний момент, когда уже вставлены необходимые логотипные рисунки в колонтитулы и подогнаны размеры колонтитулов под рисунок бланка, на который будет печататься диплом. Иначе эти операции придется выполнять отдельно по каждой породе.

Как создать макросы. Выделяете и копируете (Ctrl+C) текст прямо отсюда

Sub oglavlenie()
'
' oglavlenie Макрос
' Макрос записан 11.05.2009 XTreme
'
Selection.HomeKey Unit:=wdStory
Selection.InsertBreak Type:=wdSectionBreakNextPage
Selection.HomeKey Unit:=wdStory
Selection.Font.Size = 10
Selection.TypeText Text:="Оглавление"
Selection.TypeParagraph
With ActiveDocument
.TablesOfContents.Add Range:=Selection.Range, RightAlignPageNumbers:= _
True, UseHeadingStyles:=True, UpperHeadingLevel:=1, _
LowerHeadingLevel:=3, IncludePageNumbers:=True, AddedStyles:="", _
UseHyperlinks:=True, HidePageNumbersInWeb:=True, UseOutlineLevels:= _
True
.TablesOfContents(1).TabLeader = wdTabLeaderDots
.TablesOfContents.Format = wdIndexIndent
End With
End Sub

Sub №Род_Клеймо()
'
' glad Макрос
' Макрос записан 06.04.2009 XTreme
'
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "^p Клеймо"
.Replacement.Text = " Клеймо"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "^tОкрас"
.Replacement.Text = " Окрас"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub
Sub РазрывСвязьКолонт()
'
' РазрывСвязьКолонт Макрос
' Макрос создан 12.04.2009 XTreme
'
For I = 1 To ActiveDocument.Sections.Count
' ActiveDocument.Sections(I).Headers(wdHeaderFooterPrimary).LinkToPrevious = False
ActiveDocument.Sections(I).Footers(wdHeaderFooterPrimary).LinkToPrevious = False
Next

End Sub
Sub ОТЕЦ_МАТЬ()
'
' ОТЕЦ_МАТЬ Макрос
' Макрос записан 09.05.2009 XTreme
'
ActiveWindow.ActivePane.VerticalPercentScrolled = 0
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "^p M."
.Replacement.Text = " ^tМ."
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub
Sub ЗАВ_ВЛАД()
'
' ЗАВ_ВЛАД Макрос
' Макрос записан 09.05.2009 XTreme
'
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "^p вл.:"
.Replacement.Text = " ^tвл.:"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
ActiveWindow.ActivePane.View.ShowAll = Not ActiveWindow.ActivePane.View. _
ShowAll
'ActiveWindow.Close
End Sub

затем вставляете этот текст в вордовые макросы следующим образом. Находясь в ворде (версия 2003 и ниже) жмете кнопки меню Сервис Макрос Макросы Изменить. В открывшемся окне редактирования макросов попадаете на самый верх (Ctrl+Home), нажимаете Enter и затем вставляете этот текст (Ctrl+V). После этого закрываете окна редактирования макросов.

Как запустить нужный макрос. Жмете кнопки Сервис Макрос Макросы и в открывшемся окне списка макросов выбираете нужный и жмете кнопку Выполнить.

C 26.07.2009 изменился вид каталога. В связи с этим нужно заменить (установить) макросы: №Род_Клеймо, ЗАВ_ВЛАД, ОТЕЦ_МАТЬ

Sub №Род_Клеймо()
'
' glad Макрос
' Макрос записан 06.04.2009 XTreme
'
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "^pКлеймо"
.Replacement.Text = ", Клеймо"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
Selection.Find.Execute Replace:=wdReplaceAll
End Sub


Sub ЗАВ_ВЛАД()
'
' ЗАВ_ВЛАД Макрос
' Макрос записан 09.05.2009 XTreme
'
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "^pВл.:"
.Replacement.Text = ", Вл.:"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
' ActiveWindow.ActivePane.View.ShowAll = Not ActiveWindow.ActivePane.View. _
ShowAll
'ActiveWindow.Close
End Sub


Sub ОТЕЦ_МАТЬ()
'
' ОТЕЦ_МАТЬ Макрос
' Макрос записан 09.05.2009 XTreme
'
ActiveWindow.ActivePane.VerticalPercentScrolled = 0
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "^pM."
.Replacement.Text = ", М."
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub