1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
| Sub Макрос1() ' точка входа макроса после нажатия "Макросы->Выполнить..."
' Ключевое слово Width указывает, что все остальные строки, начинающиеся c ".",
' являются "подсвойствами" и "подметодами" для метода, указанного за этим ключевым
' словом, то есть ".Forward" на самом деле разворачивается в "Selection.Find.Forward"
With Selection.Find ' метод операции поиска, аналог меню "Найти..." в коде VBA
.Forward = True ' поиск вперед
.Wrap = wdFindContinue ' "автосогласие" на продолжение поиска после, например, замены
.MatchWildcards = True ' будем работать с подстановочными знаками для поиска.
' Что означает каждый подстановочный знак - это в Справку Word или в Интернет...
' Операция замены может "порушить" (и обязательно "порушит") все форматирование
' документа, поэтому будем проводить ее в несколько проходов
.Text = "^0013^0013" 'сначала ищем двойной символ "конец абзаца", обычно - это конец документа
.Replacement.Text = " +=++=+" ' и временно заменяем его на уникальную комбинацию символов,
' заведомо не встречающуюся в "нормальных" документах, поэтому включаем весь свой идиотизм,
' но не полностью, чтобы самим потом не забыть эту комбинацию. Внимание! Так как "конец абзаца"
' по-совместительству является еще и концом какого-нибудь слова, то чтобы потом нормально искать
' каждое четвертое слово, в эту уникальную комбинацию вначале добавляем пробел (он не виден,
' но он есть - как тот суслик)
.Execute Replace:=wdReplaceAll ' непосредственно запускаем команду поиска, но указываем параметр
' который в VBA является аналогом перехода на вкладку "Найти и заменить..." в меню "Найти..." и
' присваиваем ему значение области поиска и замены - везде - то есть по всему документу
.Text = "^0013" ' готовим 2 проход - будем искать одинарные знаки "конец абзаца"
.Replacement.Text = " +==+" ' тоже уникальная комбинация, но другая !
.Execute Replace:=wdReplaceAll ' и опять поиск и замена, уже нам известная
.Text = " @-@ @" ' в документах, особенно грамотных, иногда встречаются дефисы между словами,
' и очень часто (настолько, что всегда) они отделяются от слов пробелами, поэтому при поиске
' каждого четвертого слова мы можем случайно посчитать этот дефис как отдельное слово. Чтобы
' не лохануться, заменим-ка дефис, вместе с окружающими его пробелами, на еще более уникальную
' комбинацию, причем с одной стороны будет пробел, а с другой стороны мы ее "прикрепим"
' к рядом стоящему слову, чтобы потом посчитать его как одно целое с дефисом, точнее с этой
' уникальной комбинацией, временно заменяющей дефис
.Replacement.Text = " +=---=+" ' вот эта третья уникальная комбинация !
.Execute Replace:=wdReplaceAll ' снова поиск и замена, это уже третий проход
.Text = "<(*[^0013 ]@*[^0013 ]@*[^0013 ]@*[^0013 ]@)" ' а этот набор подстановочных знаков
' как раз ищет и выделяет сразу четыре подряд идущих слова, разделенных пробелами, причем наши
' "уникальные" комбинации с одной стороны тоже "прикреплены" к какому нибудь слову, поэтому
' временно "входят" в состав этого слова. Знак < означает, что выделение начинается прямо с
' начальной буквы (или символа) первого слова, а круглые скобки означают, что мы "группируем"
' все наше "четырехсловное" выделение. Остальные подробности по знакам - в Справку или Интернет
.Replacement.Text = "\1да " ' готовим то, на что будем менять : комбинация \1 означает ту самую
' выделенную "группу", которую при замене мы должны оставить как есть, но к ней добавим наше
' "слово-паразит" (назвать его предлогом у меня не повернется язык и не согнутся пальцы, чтобы
' набрать на клавиатуре), то есть "да " (с пробелом в конце). Итоговая строка: "\1да "
.Execute Replace:=wdReplaceAll ' фактические поиск и замена, это уже четвертый проход
.Text = " +=---=+" ' а теперь, когда "слова-паразиты" расставлены, возвращаем наше исходное
' форматирование документа, последовательно, в обратном порядке, меняя наши уникальные
' комбинации на те символы, которые были временно заменены этими комбинациями. То есть сейчас
' на этом проходе будем менять " +=---=+" на...
.Replacement.Text = " - " ' ... на дефис с пробелами вокруг него
.Execute Replace:=wdReplaceAll ' и сама замена, пятый проход
.Text = " +==+" ' еще одну "кракозябру" ...
.Replacement.Text = "^0013" ' на код "конец параграфа"
.Execute Replace:=wdReplaceAll ' сама замена, шестой проход
.Text = " +=++=+" ' и последняя (которая на первом проходе была первой) "кракозябра"
.Replacement.Text = "^0013^0013" ' на код конца документа
.Execute Replace:=wdReplaceAll ' здесь мы фактически выполняем операцию замены, седьмой проход
End With ' и коректно, по правилам VBA
End Sub ' завершаем выполнение макроса. Всем спасибо!
' Конечно же "парсинг" документа (это то, чем мы примерно занимались), весьма чувствительная к
' содержимому и структуре документа процедура и данный пример ни в коем случае не совершенен. Даже
' сейчас, комментируя программу, я заменил некоторые подстановочные знаки, исправив небольшие
' погрешности: "четырехсловный" поиск - было: <(*[^0013 ]@*[^0013 ]@*[^0013 ]@*)([^0013 ]@)
' стало <(*[^0013 ]@*[^0013 ]@*[^0013 ]@*[^0013 ]@) - убрал две лишние круглые скобки внутри. И
' вторая погрешность: подстановочный код "на что меняем" на этом же, четвертом проходе, был: "\1 да ",
' что добавляло лишний пробел, а теперь: "\1да " (между 1 и д теперь нет пробела). Но все-равно,
' например, если в документе слово "какое-нибудь" будет записано как "какое - нибудь", данный пример
' посчитает его за два. Точная подгонка под свои нужды - дело рук "нуждающегося" ! Всем удачи!!!
' ... |
(
