| 1. Что? Зачем? |
| 2. Как внедрить макрос и назначить его выполнение клавиатуре? |
| 3. Преобразование из ASCII в UNICODE и обратно |
| 4. Увеличение / уменьшение межбуквенного интервала выделенного текста |
| 5. Увеличение / уменьшение растояния между абзацами |
| 6. Увеличение / уменьшение межстрочного интервала |
| 7. Последний предлог в строке |
| 8. Первый дефис в строке |
| 9. Создание вхождения указателя |
| 10. Поиск "ц" и "ч", после которых следует точка или запятая |
| 11. Удалить гиперссылку |
| 12. Вставка элемента оглавления |
| 13. Поменять дефис между цифрами на тире |
| 14. Поставить препинание после сноски |
| 15. Удаление пробела перед знаком сноски |
| 16. Поиск инициалов при фамилии и вставка неразравных пробелов |
| 17. Вспомогательные функции |
| 18. Причесывание текста |
Поиск инициалов при фамилии и вставка неразравных пробелов
Для того, чтобы инициалы не "отрывались" от фамилии, после них вставляются неразравные пробелы. В этом макросе используются вспомогательные функции isUpper - проверка на верхний регистр, IsDigit - проверка на арабскую цифру и isRimDig - проверка на римскую цифру.
Sub ИнициалPlusSpace()' Инициал_Space Макрос
' Ищет Инициал с точкой и вставляет nbsp
Const NBSP As Integer = 160 ' Костанта "неразрывный пробел" (none breakable space)
Dim st$
Selection.Find.ClearFormatting ' Очистим контекст поиска
Do While Selection.Find.Execute(FindText:=".") ' Будем искать все точки
Selection.MoveLeft Count:=3
Selection.MoveRight Count:=3, Extend:=wdExtend
If isUpper(Selection.Text, 1) = True And isUpper(Selection.Text, 2) = True Then
' Нашли две заглавные буквы, ничего не делаем
GoTo obhod
End If
Selection.MoveRight
Selection.MoveLeft Count:=2
Selection.MoveRight Count:=4, Extend:=wdExtend
If isUpper(Selection.Text, 1) = True And _
Asc(Mid(Selection.Text, 3, 1)) <> NBSP Then
' Нашли первый заглавный символ и не NBSP
If IsDigit(Mid(Selection.Text, 4, 1)) = True Then
' Последней оказалась цифра, тоже ничего не делаем
GoTo obhod
End If
Selection.MoveRight Extend:=wdExtend ' Расширим выделение
If ( isUpper(Selection.Text, 4) = True And _
isUpper(Selection.Text, 5) = True) Or _
( isUpper(Selection.Text, 4) = True And _
Mid(Selection.Text, 5, 1) = " ") Then
' Если последние две буквы заглавние или предпоследняя заглавная,
' а последний символ - пробел, то опять ничего не делаем
GoTo obhod
End If
Selection.MoveLeft Extend:=wdExtend ' Сузим выделение
' Есть подозрение, что это инициал
' Случай 1 - после точки стоит обычный пробел
If Mid(Selection.Text, 3, 1) = " " Then
If ( isUpper(Selection.Text, 4) = True) Then
Selection.MoveLeft
Selection.MoveRight Count:=2
Selection.MoveRight Extend:=wdExtend
Selection.Text = chr(NBSP) ' Меняем пробел на NBSP
Selection.MoveRight
End If
GoTo obhod
End If
' Случай 2 - пробела нет
If isUpper(Selection.Text, 3) = True Then
Selection.MoveLeft
Selection.MoveRight Count:=2
Selection.InsertSymbol CharacterNumber:=NBSP ' Вставляем NBSP
Selection.MoveRight
End If
End If
obhod:
Selection.MoveRight
Loop
End Sub