Помогите написать макрос, где я точно могу узнать, сколько произошло замен.
Например, в макросе проводится замены всех дефисов на неразрывные и пробелов на обычные
во всем тексте:
Спойлер
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "(-)"
.Replacement.Text = ChrW(30)
.Wrap = wdFindContinue
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "([^0160]{1;})"
.Replacement.Text = "^32"
.Wrap = wdFindContinue
.MatchWildcards = True
.Format = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
или в выделении:
Спойлер
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "(-)"
.Replacement.Text = ChrW(30)
.Wrap = wdFindStop 'ищем в выделении
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "([^0160]{1;})"
.Replacement.Text = "^32"
.Wrap = wdFindStop 'ищем в выделении
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
Но вот только из-за специфики текста, мне очень точно нужно знать, сколько проведено замен. И дефисов, и тире. Причем замены идут одна за другой и привела я их не все, друг за другом таких замен у меня много.
Сколько не искала - не смогла найти готового решения.
Вот такие коды, которые попробуйте адаптировать для себя, настроив параметры поиска и добавив в коды коды по замене. Встроенных инструментов у ворд нет для подсчёта кол-ва найденного или заменённого.
Коды сделаны на случай, когда замена происходит от начала в конец (в ворде можно вести ещё замену от конца в начало - для этого случая нужны другие коды).
Замена во всём файле
Sub Main()
' Замена и подсчёт во всём файле.
Dim rng As Range, fnd As Find, lngCounter As Long
'1. Поиск и подсчёт.
'1) Создание объектов для поиска.
Set rng = ActiveDocument.Range(0, 0)
Set fnd = rng.Find
'2) Настройка поиска. Настройте поиск так же, как вы это делаете в замене.
' Только не используйте параметры, относящиеся к "Replacement", т.к.
' в данном случае они не нужны.
fnd.Text = "текст1"
fnd.Wrap = wdFindStop
'3) Поиск и подсчёт.
Do
If fnd.Execute = True Then
' Подсчёт найденных фрагментов.
lngCounter = lngCounter + 1
' Смещение невидимого курсора вправо от найденго фрагмента.
rng.Collapse Direction:=wdCollapseEnd
Else
Exit Do
End If
Loop
'2. Здесь сделайте обычную замену, которую вы использовали всегда.
'3. Сообщение.
MsgBox "Замен: " & lngCounter
End Sub
Замена в выделенном фрагменте
Sub Main()
' Замена в выделенном фрагменте.
' Подсчёт замен может оказаться меньше, чем было сделано замен на самом деле.
' Просто так нельзя выделить фрагмент, потому что в некоторых случаях поиск будет
' производиться не в выделенном фрагменте, а от начала выделенного фрагмента и до конца файла.
Dim rng As Range, fnd As Find, lngSelEnd As Long, lngCounter As Long
'1. Запись конца выделения, чтобы постоянно не обращаться к объекту "Selection".
lngSelEnd = Selection.End
'2. Поиск и подсчёт.
'1) Создание объектов для поиска.
Set rng = Selection.Range
rng.Collapse Direction:=wdCollapseStart
Set fnd = rng.Find
'2) Настройка поиска. Настройте поиск так же, как вы это делаете в замене.
' Только не используйте параметры, относящиеся к "Replacement", т.к.
' в данном случае они не нужны.
fnd.Text = "текст1"
' Чтобы поиск прекратился в конце файла и не начался заново.
fnd.Wrap = wdFindStop
'3) Поиск и подсчёт.
Do
If fnd.Execute = True Then
' Проверка, найдено ли в пределах выделенного.
If rng.End > lngSelEnd Then
Exit Do
End If
' Подсчёт.
lngCounter = lngCounter + 1
' Смещение невидимого курсора вправо.
rng.Collapse Direction:=wdCollapseEnd
Else
Exit Do
End If
Loop
'3. Здесь сделайте обычную замену, которую вы использовали всегда.
'4. Сообщение.
MsgBox "Замен: " & lngCounter
End Sub
А как правильно выделять фрагмент, чтобы поиск осуществлялся только в выделенном фрагменте, а не расширялся до конца файла?
Правила выделения, наверное, нигде не написаны. Просто нужно выделять и смотреть, правильная происходит замена или нет.
Я отношу такое поведение программы "Word" к ошибке: я считаю, что поиск должен осуществляться строго в выделенном фрагменте.
Вариант с использованием макроса и диалога "Найти и заменить".
В макросе, после команды:
VBA.SendKeys
ничего не должно быть, т.к. макрос не будет ждать окончания этой команды, а только покажет диалог и дальше продолжит выполнение.
Запускать макрос нужно только из ворд, а не из VBA, т.к. используется сочетание клавиш "Ctrl + H" и оно будет применено к VBA, а не к Word, если на мониторе отображается VBA.
Смысл такой: макрос задаёт настройки поиска и замены, затем отображает обычный диалог "Найти и заменить", вам надо щёлкнуть "Заменить все" и появится сообщение, сколько замен было сделано.
На макрос влияет язык клавиатуры. Если вы используете кроме русского и английского другие языки, то нужно изменить макрос.
Спойлер
Sub Main()
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "text1"
.Replacement.Text = "text2"
End With
If Application.Keyboard = 67699721 Then
VBA.SendKeys "^h"
Else
' Русская "р".
VBA.SendKeys "^р"
End If
End Sub
Последний вариант для меня проблематичен, т.к. у меня замен друг за другом выполняется больше 20 и следуют сразу одна за другой.
Буду применять Ваши варианты, что предложили выше. Спасибо.