1 Тема от Autum

  • Autum
  • рядовой
  • Неактивен
  • Зарегистрирован: 23.10.2015
  • Сообщений: 1

Тема: Замена макросом

Здравствуйте.
Не получается сделать замену только в выделенной области документа
макрос было записан, при этом во время записи макрос все происходит правильно
при повторном запуске макроса замена происходит во всем документе, о чем ворд и сообщает: «выполнено 100500 замен, достигнут конец документа...»
собственно сам больной:

    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "^p^p"
        .Replacement.Text = "^p"
        .Forward = True
        .Wrap = wdFindAsk
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

что не так?

2 Ответ от Александр Б.

  • Александр Б.
  • генерал-майор
  • Неактивен
  • Откуда: Москва
  • Зарегистрирован: 16.02.2013
  • Сообщений: 275
  • Поблагодарили: 60
  • За сообщение: 1

Re: Замена макросом

Надо написать не .Wrap = wdFindAsk, а .Wrap = wdFindStop. Чтобы в конце не спрашивало (ask), а останавливалось (stop).

А вообще лучше используйте макрос ниже. Я подумал, что лучше реализовать поиск и замену в виде подпрограммы, чтобы было удобно за раз сделать сразу несколько замен. Запускайте Макрос1. Добавляйте новые строки по вызову процедуры Call BWT_FindReplace, если нужны другие замены.

Sub Макрос1()
'тестовый макрос
  Call BWT_FindReplace("^p^p", "^p")
  Call BWT_FindReplace("прЕмер зОмены", "пример замены")
End Sub

Sub BWT_FindReplace(s1 As String, s2 As String)
'найти и заменить строки s1 на s2
  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
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
  End With
  
  If Selection.Range.End - Selection.Range.Start > 1 Then
    'если выделено два или более символов, тогда выполняем замену
    Selection.Find.Execute Replace:=wdReplaceAll
  Else
    'иначе ничего не делаем и выводим сообщение
    MsgBox "Выделите не менее двух символов!"
  End If
  'Примечание - Если не делать эту проверку, то может произойти нежелательная замена до конца документа.
End Sub
Мой шаблон/макросы для автоматической нумерации Word 2003, 2007, 2010 и т.д. (стили, названия, перекрестные ссылки, LISTNUM). Делюсь: http://vk.com/club_alex_bir

СайтАлександр Б.

3 Ответ от Александр Б.

  • Александр Б.
  • генерал-майор
  • Неактивен
  • Откуда: Москва
  • Зарегистрирован: 16.02.2013
  • Сообщений: 275
  • Поблагодарили: 60

Re: Замена макросом

В макросе выше я сделал "защиту от дурака", чтобы случайно не заменить всё до конца документа. Можно закоментировать вывод сообщения, вот так:

  If Selection.Range.End - Selection.Range.Start > 1 Then
    'если выделено два или более символов, тогда выполняем замену
    Selection.Find.Execute Replace:=wdReplaceAll
'  Else
'    'иначе ничего не делаем и выводим сообщение
'    MsgBox "Выделите не менее двух символов!"
  End If
  'Примечание - Если не делать эту проверку, то может произойти нежелательная замена до конца документа.

А то это сообщение будет выскакивать несколько раз, если в главной программе (Макрос1) вы будете несколько раз вызывать подпрограмму.

Мой шаблон/макросы для автоматической нумерации Word 2003, 2007, 2010 и т.д. (стили, названия, перекрестные ссылки, LISTNUM). Делюсь: http://vk.com/club_alex_bir

СайтАлександр Б.

4 Ответ от Terrano

  • Замена макросом
  • Terrano
  • сержант
  • Неактивен
  • Зарегистрирован: 08.11.2015
  • Сообщений: 11

Re: Замена макросом

Помогите пожалуйста разобраться в ситуацией.

Есть текст, много текстов, очень много текстов. Частенько бывает, что надо менять шрифт с одного на другой. Пока все делаю вручную, с помощью "Ctrl+H -> Заменить все", и замена с одного шрифта на другой без проблем. Как только пишу макрос, потом иду в VBasic, смотрю по командам, а там про шрифт-то ни словечка.

Вот что у меня получается:

Sub Макрос1()
'
' Макрос1 Макрос
'
'
    Selection.Find.ClearFormatting
    Selection.Find.Font.Size = 12
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Font.Size = 8
    With Selection.Find.Replacement.ParagraphFormat
        .SpaceBeforeAuto = False
        .SpaceAfterAuto = False
        .LineSpacingRule = wdLineSpaceSingle
        .FirstLineIndent = CentimetersToPoints(0.5)
        .CharacterUnitFirstLineIndent = 0
    End With
    With Selection.Find.Replacement.ParagraphFormat
        With .Shading
            .Texture = wdTextureNone
            .ForegroundPatternColor = wdColorBlack
            .BackgroundPatternColor = wdColorBlack
        End With
        .Borders.Shadow = False
    End With
    With Selection.Find
        .Text = ""
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub