Ниже приведен макрос для очистки от мусора выделенного текста. Ниже даны три процедуры. Лучше их засунуть в отдельный модуль.
Выделяете фрагмент текста и запускаете процедуру X_TempMacro.
Основная неприятность с заменами заключается в том, что после точки не всегда нужно вставлять пробел. Поэтому в конец процедуры WildcardsReplaceProcedures нужно добавить исключения, вроде таких:
Call ReplaceSomeText("([Тт].)[^0032^s](к.)", "\1\2") 'заменить "т. к." на "т.к."
Когда наберется несколько исключений, скажем, пять-десять, можно их в этой теме сообщить, и они будут учтены.
Я немного изменил поисковые слова Карандаша; в комментариях это описано. В дальнейшем этот макрос будет доделан в части обработки начал абзацев.
Sub WildcardsReplaceProcedures()
'Несколько процедур поиска и замены с использованием подстановочных знаков
' 1) Ищем два и более пробелов подряд " {2;}" и заменяем на пробел " " (пробел можно записать как " " или "^0032").
Call ReplaceSomeText("^0032{2;}", "^0032") '
'Примечание - Искомый символ (пробел) задан перед фигурной скобкой, точка с запятой означает "и более" _
Точка с запятой в операторах {n;} и {n;m} — это не просто точка с запятой, а так называемый List separator _
(Разделитель элементов списка). В США это запятая, в России — точка с запятой. _
Чтобы узнать, какой символ играет роль разделителя элементов списка в вашей конфигурации, _
загляните в Control Panel | Regional Settings | Numbers | List separator _
(Панель управления | Язык и стандарты | Числа | Разделитель элементов списка).
' 2) Удаляем один и более пробелов ПЕРЕД знаками пунктуации, перед символами ")", "%" и перед концом абзаца.
Call ReplaceSomeText(" {1;}([.,:;\!\?\%\)\^0013])", "\1")
'Примечание - Квадратные скобки означают ИЛИ, т.е. ищется любой из символов в кв. скобках. _
Единица "\1" означает порядковый номер выражения _
(выражение это то, что заключается в круглые скобки; здесь выражение одно). _
^0013 это знак абзаца (код ASCII). _
Вместо \) можно было бы написать просто курглую скобку ), в этом случае тоже работает.
' 3) Удаляем пробел ПОСЛЕ символа "(".
Call ReplaceSomeText("\( ", "(")
'Внимание - Здесь я не хочу удалять пробел в начале абзаца, что записывается так: _
.Text = "([\(^0013])^0032" _
.Replacement.Text = "\1" _
Это удалило бы пробел в начале абзацев, кроме первого. _
Причина в том, что я прочитал в интеренете следующее сообщение: _
"...впечатываем в поле "Найти" ^0013^0032{1;} в поле "Заменить на" ^0013 и в результате _
удаляется любое количество пробелов в начале абзаца. _
Но есть одна проблема: если к абзацам применены разные стили, то стиль предшествующего абзаца _
заменяется на стиль последующего." _
Пробел в начале абзацев я удалю другими способами (кстати, в начале абзаца может потребоваться удалить _
не только пробел, но и, например, "жесткий" номер заголовка 1.1.1 и табуляцию).
' 4) Вставляем пробел ПОСЛЕ знаков пунктуации и после ")", "%", если после них нет пробела, НЕРАЗРЫВНОГО_ПРОБЕЛА, _
цифры или конца абзаца
''' Call ReplaceSomeText("([.,:;\!\?\)%])([!^0032^00130123456789])", "\1^0032\2") 'вариант Карандаша
Call ReplaceSomeText("([.,:;\!\?\)%])([!^0032^s^00130-9])", "\1^0032\2") 'мой вариант с неразрывным пробелом ^s
'Внимание - Вставка пробела после точки не всегда нужна. Например: _
"т.е." заменяется на "т. е.", _
"т.к." на "т. к.", _
"А.А. Бирюков" на "А. А. Бирюков" _
Поэтому далее нужно удалить лишние вставленные пробелы _
(либо, как вариант, можно просто убрать точку из квадратных скобок в текущей процедуре).
' 5) Вставляем пробел ПЕРЕД скобкой "(", если перед ней нет пробела ^0032 или неразрывного пробела ^s
Call ReplaceSomeText("([!^0032^s])\(", "\1 (")
' Примечание - Восклицательный знак в [!^0032^s] означает, что символ не является пробелом или _
неразрывным пробелом _
' Круглые скобки (выражение) тут обязательно нужны, чтобы не удалять символ найденный слева от "("
'''''''' Начало процедур удаления лишних вставленных пробелов
' Заменить выражение типа "А. А. Бирюков" на "А.А.^sБирюков" _
(между буквами может быть пробел ^0032 или неразрывный пробел ^s)
Call ReplaceSomeText("([А-ЯЁ].)[^0032^s]([А-ЯЁ].)[^0032^s]([А-ЯЁ])", "\1\2^s\3")
Call ReplaceSomeText("([Тт].)[^0032^s](к.)", "\1\2") 'заменить "т. к." на "т.к."
Call ReplaceSomeText("([Тт].)[^0032^s](е.)", "\1\2") 'заменить "т. е." на "т.е."
Call ReplaceSomeText("(\))[^0032^s](.)", "\1\2") 'заменить ") ." на ")."
' *** ДОБАВЬТЕ ДОПОЛНИТЕЛЬНЫЕ ПРОЦЕДУРЫ ReplaceSomeText ДЛЯ ИСПРАВЛЕНИЯ ВСЕХ ИСКЛЮЧЕНИЙ ***
'''''''' Конец процедур удаления лишних вставленных пробелов
End Sub
Sub ReplaceSomeText(s1 As String, s2 As String, Optional blnWildcards As Boolean = True)
'Найти и заменить некий текст
'Ищет в текущем выделении фрагменты текста s1 и заменяет их на s2
'blnWildcards - необязательный агрумент, если не указан, то равен True, и подстановочные знаки включены.
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = s1 'искомый текст
.Replacement.Text = s2 'текст для замены
.Forward = True
.Wrap = wdFindStop 'в конце останавливаем поиск без переспросов
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchWildcards = blnWildcards 'подстановочные знаки включены (True) или отключены (False)
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub
Sub X_TempMacro()
' Очистка выделенного текста от "мусора"
Dim x1, x2
x1 = Selection.Range.Start 'левая граница выделения
x2 = Selection.Range.End 'правая граница выделения
If x1 = x2 Then Exit Sub 'если границы совпадают, то завершаем процедуру _
(это защита от дурака, чтобы случайно не очистить весь документ целиком)
Application.ScreenUpdating = False 'отключаем обновление экрана _
(для увеличения скорости выполнения замен)
'Несколько процедур поиска и замены, с использованием подстановочных знаков
Call WildcardsReplaceProcedures
Application.ScreenUpdating = True 'включаем обновление экрана
' *** НИЖЕ ДОБАВЛЮ ПРОЦЕДУРУ ОБРАБОТКИ НАЧАЛ АБЗАЦЕВ ***
''переходим в начало абзаца
'Dim oRng As Range
' Set oRng = Selection.Paragraphs(1).Range
' oRng.Collapse wdCollapseStart
' oRng.Select
'
''выделяем один символ в начале абзаца
' Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
' If Selection.Text = " " Then
' Selection.Delete Unit:=wdCharacter, Count:=1 'если это пробел, то удаляем
' Else
' Selection.MoveLeft Unit:=wdCharacter, Count:=1 'иначе, влево на один
' End If
End Sub
Мой шаблон/макросы для автоматической нумерации Word 2003, 2007, 2010 и т.д. (стили, названия, перекрестные ссылки, LISTNUM). Делюсь: http://vk.com/club_alex_bir
)