Добрый день участникам форума. Это снова я )
Я потихоньку дорабатываю свой код по замене слов в документе. Кратко введу в курс того что у меня уже есть. А есть у меня макрос который заменяет нужные мне слова в документе на другие. То есть: Клиент - принципал, Приложение - Дополнительное Соглашение и т.д. (Большая проблема с окончаниями, с ней я борюсь используя select case.
Сейчас код работает в ручном режиме исправно и гладко. Я выделяю слово, включаю макрос и все аналогичные слова в документе заменяются и подсвечиваются. Я хочу запустить макрос в автоматическом режиме. Что бы он искал и заменял слова в определенном порядке. Давайте подумаем как это грамотно сделать. Использовать Wend или For или может как то еще.
Для того что бы лучше было понятно как макрос работает я выкладываю код и не обработанный макросом документ. Для замены слова выберите к примеру "Исполнитель" и по всему документу он у вас будет заменен.
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.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
114.
115.
116.
117.
118.
119.
120.
121.
122.
123.
124.
125.
126.
127.
128.
129.
130.
Sub selectWord2()
Dim rTmp As Range
Set rTmp = ActiveDocument.Range ' rTmp = Это весь документ
With rTmp.Find ' Ищем в документе
.Text = Selection.Text
Select Case .Text
Case "Клиент"
MsgBox "Клиент заменяем на Принципал"
.Replacement.Text = "Принципал"
.Replacement.Highlight = wdBrightGreen
Case "Заказчик"
MsgBox "Заказчик заменяем на Принципал"
.Replacement.Text = "Принципал"
.Replacement.Highlight = wdBrightGreen
'....ПРИЛОЖЕНИЕ.....
Case "Приложения" To "Приложения "
MsgBox "Приложения заменяем на Дополнительные соглашения"
If Selection.Text = "Приложения " Then
.Replacement.Text = "Дополнительные соглашения "
Else
.Replacement.Text = "Дополнительные соглашения"
End If
Case "Приложение" To "Приложение "
MsgBox "Приложение заменяем на Дополнительное соглашение"
If Selection.Text = "Приложение " Then
.Replacement.Text = "Дополнительное соглашение "
Else
.Replacement.Text = "Дополнительное соглашение"
End If
Case "Приложению"
MsgBox "Приложению заменяем на Дополнительному соглашению"
.Replacement.Text = "Дополнительному соглашению"
Case "Приложениями"
MsgBox "Приложениями заменяем на Дополнительными соглашениями"
.Replacement.Text = "Дополнительными соглашениями"
Case "Приложениях"
MsgBox "Приложениях заменяем на Дополнительных соглашениях"
.Replacement.Text = "Дополнительных соглашениях"
Case "Приложением"
MsgBox "Приложением заменяем на Дополнительным соглашением"
.Replacement.Text = "Дополнительным соглашением"
Case "Приложении"
MsgBox "Приложении заменяем на Дополнительном соглашении"
.Replacement.Text = "Дополнительном соглашении"
Case "Поручения"
MsgBox "Поручения заменяем на Дополнительного соглашения"
.Replacement.Text = "Дополнительного соглашения"
Case "Поручение"
MsgBox "Приложениях заменяем на Дополнительное соглашениие"
.Replacement.Text = "Дополнительное соглашениие"
Case "Поручением"
MsgBox "Поручением заменяем на Дополнительным соглашением"
.Replacement.Text = "Дополнительным соглашением"
Case "Поручению"
MsgBox "Поручению заменяем на Дополнительному соглашению"
.Replacement.Text = "Дополнительному соглашению"
'....Исполнитель / Редакция .....
Case "Исполнитель"
MsgBox "Исполнитель заменяем на Агент"
.Replacement.Text = "Агент"
.Replacement.Highlight = wdBrightGreen
Case "Исполнителю"
MsgBox "Исполнителю заменяем на Агенту"
.Replacement.Text = "Агенту"
Case "Исполнителя"
MsgBox "Исполнителя заменяем на Агента"
.Replacement.Text = "Агента"
Case "Исполнителем"
MsgBox "Исполнителем заменяем на Агентом"
.Replacement.Text = "Агентом"
Case "Редакция"
MsgBox "Редакция заменяем на Агент"
.Replacement.Text = "Агент"
Case "Редакцию"
MsgBox "Редакцию заменяем на Агенту"
.Replacement.Text = "Агенту"
Case "Редакции"
MsgBox "Редакции заменяем на Агента"
.Replacement.Text = "Агента"
Case "Редакцией"
MsgBox "Редакцией заменяем на Агентом"
.Replacement.Text = "Агентом"
'....ДОГОВОР.....
Case "Договор "
MsgBox "Внимение: Лучше использовать полную формулировку, настоящий Договор. Иначе будет звучать не по Русски Настоящий Приложение"
' if .Text - Дописать условие проверки на окончание. Отсчитать от первой буквы "Д" в слове "Договор", - 3 символа.
' Узнать окончание окнчание слова, стоящее перед искомым словом. Если полученное окончание будет равно = "щий", то заменить его на "щее"
.Replacement.Text = "Приложение "
Case "Настоящий Договор" To "настоящий Договор"
If Selection.Text = "Настоящий Договор" Then
MsgBox "Настоящий Договор заменяем на Настоящее Приложение"
.Replacement.Text = "Настоящее Приложение"
Else
MsgBox "настоящий Договор заменяем на настоящее Приложение"
.Replacement.Text = "настоящее Приложение"
End If
Case "Договора"
MsgBox "Договора заменяем на Приложения"
.Replacement.Text = "Приложения"
Case "Договору"
MsgBox "Договору заменяем на Приложению"
.Replacement.Text = "Приложению"
Case "Договором"
MsgBox "Договором заменяем на Приложением"
.Replacement.Text = "Приложением"
Case "Договоре"
MsgBox "Договоре заменяем на Приложении"
.Replacement.Text = "Приложении"
Case Else
MsgBox "Условие не совпало"
End
End Select
.Replacement.Highlight = True
.Execute Replace:=wdReplaceAll
End With
p.s.
Прощу прощения за наверное неверное написание и визуальное отображение. Поймите я не программист, но я стараюсь))
