Макрос: найти все, копировать

[entscheiden]

Здравствуйте.
Промежуточная стадия макроса (записывал макрорекордером) -- поиск в документе всех фрагментов, удовлетворяющих заданному условию (используются подстановочные знаки) и копирование найденных фрагментов.

Макрорекордер записывает все параметры поиска, а команду "Найти все" игнорирует.

[garik64]

WordBasic.EditOfficeClipboard

Selection.Copy

[entscheiden]

garik64
Выдает ошибку "Метод или свойство недоступны, поскольку выделенный текст отсутствует".

[viter.alex]

не игнорирует. Там в параметрах поиска указывается, что нужно продолжить поиск после нахождения нужного фрагмента. Но в вашем случае нужно похитрее. Куда копировать фрагменты-то?

[entscheiden]

viter.alex
Все найденные фрагменты предполагалось вставить в новый документ для дальнейшей обработки.

[viter.alex]

Ну как-то так

Sub FindCopyPaste()
  Dim NewDoc As Document
  Dim OldDoc As Document
  Dim oRng As Range
  
  Set OldDoc = ActiveDocument
  
  'Создаём новый документ и запоминаем его диапазон
  Set NewDoc = Documents.Add
  Set oRng = NewDoc.Range
  
  'Поиск в основном документе (активном на момент запуска макроса)
  With OldDoc.Range.Find
    .Text = "[абвг]" 'Выражение для поиска
    .MatchWildcards = True
    'Пока поиск завершился успешно
    While .Execute
      .Parent.Copy 'Копируем найденный фрагмент в буфер
      'И вставляем в новый документ
      oRng.Collapse wdCollapseEnd
      oRng.Paste
    Wend
  End With
End Sub

Но можно и не засорять буфер обмена, если не нужно сохранение форматирования

[entscheiden]

viter.alex
Работает, большое спасибо.