В документах с помощью автозамены делаются одни и те же процедуры замены искомых фрагментов:
1. Найти: Text1 Заменить на ^pText1^p
2. Найти: Text2 Заменить на ^pText2^p
...
8. Найти: Text8 Заменить на ^pText8^p
^p - знак абзаца
Возможно ли создать макрос, который будет применять автозамену всех 8-ми элементов в документе за один клик?
Макрос
Sub Макрос()
' Отключение монитора. Может это ускорит макрос.
Application.ScreenUpdating = False
' Замена 1.
With ActiveDocument.Range.Find
.Text = "Text1"
.Replacement.Text = "^pText1^p"
.Execute Replace:=wdReplaceAll
End With
' Замена 2.
With ActiveDocument.Range.Find
.Text = "Text2"
.Replacement.Text = "^pText2^p"
.Execute Replace:=wdReplaceAll
End With
' Замена 3 и т.д.
' Включение монитора.
Application.ScreenUpdating = True
' Сообщение.
MsgBox "Готово.", vbInformation
End Sub
Если замена однотипная, то вариант, чтобы было меньше кода.
Вносите изменения в пункты 1 и 2.
Вверху модуля вставьте этот текст:
Option Explicit
Option Compare Text
Option Base 1
Макрос
Sub Макрос()
'1. В скобках укажите количество слов, которое надо заменить.
Dim arr(2), i As Long
' Отключение монитора. Может это ускорит макрос.
Application.ScreenUpdating = False
'2. Сюда запишите слова, которые нужно заменить.
arr(1) = "Text1"
arr(2) = "Text2"
' Замена.
For i = 1 To UBound(arr)
With ActiveDocument.Range.Find
.Text = arr(i)
.Replacement.Text = "^p" & arr(i) & "^p"
.Execute Replace:=wdReplaceAll
End With
Next i
' Включение монитора.
Application.ScreenUpdating = True
' Сообщение.
MsgBox "Готово.", vbInformation
End Sub
Спасибо большое!!! Макрос работает.