Макросы и другие средства MS Word, облегчающие работу с оглавлениями и описаниями

Замена троеточий точками в оглавленияхПрименимо для обработки оглавлений, в которых в качестве заполнителя вместо точек используются троеточия.
Желательно предварительно скопировать оглавление в отдельный пустой файл.
Перед запуском макроса курсор устанавливается в начале текста.
Обычно достаточно одного прохода.Найти и заменить – Заменить (Ctrl+H).
Найти – … (троеточие)
Заменить –. (точка)
Кнопка Заменить все.

Удаление пробелов перед точками в оглавленияхПрименимо для обработки оглавлений, в которых в качестве заполнителя используются точки.
Желательно предварительно скопировать оглавление в отдельный пустой файл.
Перед запуском макроса курсор устанавливается в начале текста.
Обычно достаточно одного прохода, но при необходимости процедуру можно повторить.Найти и заменить – Заменить (Ctrl+H).
Найти – [пробел]. (пробел и точка)
Заменить –. (точка)
Кнопка Заменить все.

Удаление лишних точек в оглавленииПрименимо для обработки оглавлений, в которых в качестве заполнителя используются точки.
Желательно предварительно скопировать оглавление в отдельный пустой файл.
Перед запуском макроса курсор устанавливается в начале текста.
Выполняется до тех пор, пока количество замен не будет равно нулю.Найти и заменить – Заменить (Ctrl+H).
Найти –.. (две точки)
Заменить –. (одна точка)
Кнопка Заменить все.

Макрос для удаления цифр в конце строкПрименимо для обработки оглавлений.
Желательно предварительно скопировать оглавление в отдельный пустой файл.
Перед запуском макроса курсор устанавливается в начале текста.
Один проход макроса производит удаление одной цифры в конце каждой строки. Для книг с трехзначной нумерацией необходимо выполнить три прохода.

Sub DeletePagesFromEnd_1()
'
' Удаление цифр в конце строк
'
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
. Text = " ^p"
. Replacement.Text = "^p"
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
. Text = " ^p"
. Replacement.Text = "^p"
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
. Text = "1^p"
. Replacement.Text = "^p"
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
. Text = "2^p"
. Replacement.Text = "^p"
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
. Text = "3^p"
. Replacement.Text = "^p"
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
. Text = "4^p"
. Replacement.Text = "^p"
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
. Text = "5^p"
. Replacement.Text = "^p"
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
. Text = "6^p"
. Replacement.Text = "^p"
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
. Text = "7^p"
. Replacement.Text = "^p"
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
. Text = "8^p"
. Replacement.Text = "^p"
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
. Text = "9^p"
. Replacement.Text = "^p"
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
. Text = "0^p"
. Replacement.Text = "^p"
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
. Text = ".."
. Replacement.Text = "."
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
. Text = ".."
. Replacement.Text = "."
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
. Text = ". "
. Replacement.Text = "."
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
. Text = "?."
. Replacement.Text = "?"
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub

Расстановка точек в оглавлении в конце каждой строкиПрименимо для обработки оглавлений.
Желательно предварительно скопировать оглавление в отдельный пустой файл.
Перед запуском макроса курсор устанавливается в начале текста.
Обычно достаточно одного прохода.

Sub DotFromEnd_1()
'
' Расстановка точек в конце каждой строки
'
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
. Text = "?."
. Replacement.Text = "?"
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
. Text = ".."
. Replacement.Text = "."
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
. Text = "^p.^p"
. Replacement.Text = "^p^p"
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
. Text = " ^p"
. Replacement.Text = "^p"
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
. Text = " ^p"
. Replacement.Text = "^p"
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
. Text = "^p"
. Replacement.Text = ".^p"
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
. Text = ". "
. Replacement.Text = "."
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
. Text = "?."
. Replacement.Text = "?"
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
. Text = ".."
. Replacement.Text = "."
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
. Text = "^p.^p"
. Replacement.Text = "^p^p"
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub

Обобщенный макрос. Теперь можно выделить обрабатываемое содержание в Ворде, и макрос должен выполнить за вас всю работу! :)
Поскольку весь макрос целиком здесь не помещается, мне пришлось разделить его на три части, которые нужно соединить вместе.Часть 1:

Sub CompletePreparationSelection_1()
Dim a As Boolean
Dim i As Integer
Dim rng As Range
Set rng = Selection.Range
rng.Select
Selection.MoveLeft Unit:=wdCharacter, Count:=1
rng.Find.ClearFormatting
rng.Find.Replacement.ClearFormatting
With rng.Find
. Text = "…"
. Replacement.Text = "."
. Wrap = wdFindStop
. Execute Replace:=wdReplaceAll
End With
rng.Select
With rng.Find
. Text = vbTab
. Replacement.Text = "."
. Wrap = wdFindStop
End With
rng.Find.Execute Replace:=wdReplaceAll
With rng.Find
. Text = ". "
. Replacement.Text = "."
. Wrap = wdFindStop
End With
rng.Find.Execute Replace:=wdReplaceAll
With rng.Find
. Text = ". "
. Replacement.Text = "."
. Wrap = wdFindStop
End With
rng.Find.Execute Replace:=wdReplaceAll
rng.Select
With rng.Find
. Text = " "
. Replacement.Text = " "
. Wrap = wdFindStop
. Execute Replace:=wdReplaceAll
End With
rng.Select
a = rng.Find.Found
Do While a = True
a = rng.Find.Found
rng.Select
With rng.Find
. Text = " "
. Replacement.Text = " "
. Wrap = wdFindStop
. Execute Replace:=wdReplaceAll
End With
rng.Select
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Loop
With rng.Find
. Text = "... "
. Replacement.Text = "."
. Wrap = wdFindStop
End With
a = rng.Find.Found
Do While a = True
a = rng.Find.Found
rng.Find.Wrap = wdFindStop
rng.Find.Execute Replace:=wdReplaceAll
rng.Select
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Loop
For i = 1 To 5
With rng.Find
. Text = "^p "
. Replacement.Text = "^p"
. Wrap = wdFindStop
End With
rng.Find.Execute Replace:=wdReplaceAll
With rng.Find
. Text = "^p "
. Replacement.Text = "^p"
. Wrap = wdFindStop
End With
rng.Find.Execute Replace:=wdReplaceAll
With rng.Find
. Text = "^p."
. Replacement.Text = "^p"
. Wrap = wdFindStop
End With
rng.Find.Execute Replace:=wdReplaceAll

Часть 2 (продолжение):

With rng.Find
. Text = "^p1"
. Replacement.Text = "^p"
. Wrap = wdFindStop
End With
rng.Find.Execute Replace:=wdReplaceAll
With rng.Find
. Text = "^p2"
. Replacement.Text = "^p"
. Wrap = wdFindStop
End With
rng.Find.Execute Replace:=wdReplaceAll
With rng.Find
. Text = "^p3"
. Replacement.Text = "^p"
. Wrap = wdFindStop
End With
rng.Find.Execute Replace:=wdReplaceAll
With rng.Find
. Text = "^p4"
. Replacement.Text = "^p"
. Wrap = wdFindStop
End With
rng.Find.Execute Replace:=wdReplaceAll
With rng.Find
. Text = "^p5"
. Replacement.Text = "^p"
. Wrap = wdFindStop
End With
rng.Find.Execute Replace:=wdReplaceAll
With rng.Find
. Text = "^p6"
. Replacement.Text = "^p"
. Wrap = wdFindStop
End With
rng.Find.Execute Replace:=wdReplaceAll
With rng.Find
. Text = "^p7"
. Replacement.Text = "^p"
. Wrap = wdFindStop
End With
rng.Find.Execute Replace:=wdReplaceAll
With rng.Find
. Text = "^p8"
. Replacement.Text = "^p"
. Wrap = wdFindStop
End With
rng.Find.Execute Replace:=wdReplaceAll
With rng.Find
. Text = "^p9"
. Replacement.Text = "^p"
. Wrap = wdFindStop
End With
rng.Find.Execute Replace:=wdReplaceAll
With rng.Find
. Text = "^p0"
. Replacement.Text = "^p"
. Wrap = wdFindStop
End With
rng.Find.Execute Replace:=wdReplaceAll
With rng.Find
. Text = "^p."
. Replacement.Text = "^p"
. Wrap = wdFindStop
End With
rng.Find.Execute Replace:=wdReplaceAll
With rng.Find
. Text = "^p "
. Replacement.Text = "^p"
. Wrap = wdFindStop
End With
rng.Find.Execute Replace:=wdReplaceAll
With rng.Find
. Text = " ^p"
. Replacement.Text = "^p"
. Forward = True
. Wrap = wdFindStop
End With
rng.Find.Execute Replace:=wdReplaceAll
With rng.Find
. Text = " ^p"
. Replacement.Text = "^p"
. Wrap = wdFindStop
End With
rng.Find.Execute Replace:=wdReplaceAll
With rng.Find
. Text = "1^p"
. Replacement.Text = "^p"
. Wrap = wdFindStop
End With
rng.Find.Execute Replace:=wdReplaceAll
With rng.Find
. Text = "2^p"
. Replacement.Text = "^p"
. Wrap = wdFindStop
End With
rng.Find.Execute Replace:=wdReplaceAll
With rng.Find
. Text = "3^p"
. Replacement.Text = "^p"
. Wrap = wdFindStop
End With
rng.Find.Execute Replace:=wdReplaceAll
With rng.Find
. Text = "4^p"
. Replacement.Text = "^p"
. Wrap = wdFindStop
End With
rng.Find.Execute Replace:=wdReplaceAll

Часть 3 (окончание):

With rng.Find
. Text = "5^p"
. Replacement.Text = "^p"
. Wrap = wdFindStop
End With
rng.Find.Execute Replace:=wdReplaceAll
With rng.Find
. Text = "6^p"
. Replacement.Text = "^p"
. Wrap = wdFindStop
End With
rng.Find.Execute Replace:=wdReplaceAll
With rng.Find
. Text = "7^p"
. Replacement.Text = "^p"
. Wrap = wdFindStop
End With
rng.Find.Execute Replace:=wdReplaceAll
With rng.Find
. Text = "8^p"
. Replacement.Text = "^p"
. Wrap = wdFindStop
End With
rng.Find.Execute Replace:=wdReplaceAll
With rng.Find
. Text = "9^p"
. Replacement.Text = "^p"
. Wrap = wdFindStop
End With
rng.Find.Execute Replace:=wdReplaceAll
With rng.Find
. Text = "0^p"
. Replacement.Text = "^p"
. Wrap = wdFindStop
End With
rng.Find.Execute Replace:=wdReplaceAll
Next i
With rng.Find
. Text = "? "
. Replacement.Text = "?"
. Wrap = wdFindStop
End With
rng.Find.Execute Replace:=wdReplaceAll
With rng.Find
. Text = "... "
. Replacement.Text = "."
. Wrap = wdFindStop
End With
rng.Find.Execute Replace:=wdReplaceAll
With rng.Find
. Text = "^p.^p"
. Replacement.Text = "^p^p"
. Wrap = wdFindStop
End With
rng.Find.Execute Replace:=wdReplaceAll
With rng.Find
. Text = " ^p"
. Replacement.Text = "^p"
. Wrap = wdFindStop
End With
rng.Find.Execute Replace:=wdReplaceAll
With rng.Find
. Text = " ^p"
. Replacement.Text = "^p"
. Wrap = wdFindStop
End With
rng.Find.Execute Replace:=wdReplaceAll
With rng.Find
. Text = "^p"
. Replacement.Text = ".^p"
. Wrap = wdFindStop
End With
rng.Find.Execute Replace:=wdReplaceAll
With rng.Find
. Text = ". "
. Replacement.Text = "."
. Wrap = wdFindStop
End With
rng.Find.Execute Replace:=wdReplaceAll
With rng.Find
. Text = "? "
. Replacement.Text = "?"
. Wrap = wdFindStop
End With
rng.Find.Execute Replace:=wdReplaceAll
With rng.Find
. Text = "... "
. Replacement.Text = "."
. Wrap = wdFindStop
End With
rng.Find.Execute Replace:=wdReplaceAll
With rng.Find
. Text = "^p.^p"
. Replacement.Text = "^p^p"
. Wrap = wdFindStop
End With
rng.Find.Execute Replace:=wdReplaceAll
With rng.Find
. Text = ". "
. Replacement.Text = "."
. Wrap = wdFindStop
End With
rng.Find.Execute Replace:=wdReplaceAll
End Sub