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
|