На главную страницу   На домашнюю страницу автора
Примечание
1. Что? Зачем?
2. Как внедрить макрос и назначить его выполнение клавиатуре?
3. Преобразование из ASCII в UNICODE и обратно
4. Увеличение / уменьшение межбуквенного интервала выделенного текста
5. Увеличение / уменьшение растояния между абзацами
6. Увеличение / уменьшение межстрочного интервала
7. Последний предлог в строке
8. Первый дефис в строке
9. Создание вхождения указателя
10. Поиск "ц" и "ч", после которых следует точка или запятая
11. Удалить гиперссылку
12. Вставка элемента оглавления
13. Поменять дефис между цифрами на тире
14. Поставить препинание после сноски
15. Удаление пробела перед знаком сноски
16. Поиск инициалов при фамилии и вставка неразравных пробелов
17. Вспомогательные функции
18. Причесывание текста

Причесывание текста

Эти макросы предназначены для исправления ошибок набора текста, например, удаляет пробелы перед знаками препинания, вставляет неразрывные пробелы в сокращения (т.д.) и перед заглавными предлогами (они не должны оказаться в конце строки) и т. д.
Attribute VB_Name = "TextProc"
Sub CоrrectAll()

CorPredlog
CorPunct
FndRpl "т. е.", "т." & chr(160) & "е."
FndRpl "т.е.", "т." & chr(160) & "е."
FndRpl "т. е.", "т." & chr(160) & "е."
FndRpl "и т. п.", "и т." & chr(160) & "п."
FndRpl "и т.п.", "и т." & chr(160) & "п."
FndRpl "и т. д.", "и т." & chr(160) & "д."
FndRpl "и т.д.", "и т." & chr(160) & "д."
FndRpl " в.", chr(160) & "в."
FndRpl " вв.", chr(160) & "вв."
FndRpl " г.", chr(160) & "г."
FndRpl " гг.", chr(160) & "гг."
FndRpl "н.э.", "н." & chr(160) & "э."
FndRpl " - ", chr(160) & chr(150) & " "
FndRpl "...", chr(133)
FndRpl chr(151), chr(150)


End Sub
Sub CorPunct()
Dim punct, p
punct = Array(" )", "( ", " ,", " .", "[ ", " ]", "{ ", " }", " !", " ?", " :", " ;")
    For Each p In punct
        Selection.Find.ClearFormatting
        With Selection.Find
            .Text = p
            .Replacement.Text = Trim(p)
            .Forward = True
            .Wrap = wdFindContinue
            .Format = False
            .MatchCase = True
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
        End With
        Selection.Find.Execute Replace:=wdReplaceAll
    Next
End Sub

Sub CorPredlog()
Dim predl, p
predl = Array("А", "В", "И", "К", "О", "С", "У", "Я")

    For Each p In predl
        Selection.Find.ClearFormatting
        With Selection.Find
            .Text = p & " "
            .Replacement.Text = p & chr(160)
            .Forward = True
            .Wrap = wdFindContinue
            .Format = False
            .MatchCase = True
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
        End With
        Selection.Find.Execute Replace:=wdReplaceAll
    Next
End Sub

Sub FndRpl(Fnd, repl)
        Selection.Find.ClearFormatting
        With Selection.Find
            .Text = Fnd
            .Replacement.Text = repl
            .Forward = True
            .Wrap = wdFindContinue
            .Format = False
            .MatchCase = True
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
        End With
        Selection.Find.Execute Replace:=wdReplaceAll
End Sub