Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Word
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 04.04.2019, 14:56   #1
sevik111
Пользователь
 
Регистрация: 12.05.2011
Сообщений: 12
По умолчанию копирование абзаца в новый документ

Приветствую. Прошу помощи с макросом.
Нужно находить слова (словосочетания) в тексте и по найденому слову, копировать всю строку (абзац) в другой документ (у меня другой документ назван "Совпадения".
пример: Как в сказке о царе салтане. Находить слово мама и всю строку(абзац) копировать в другой документ. Поиск произвожу стандартным вордовским "найти". Документ для примера со словом "мама" прикрепляю.
пример.docx

Макрос, что у меня получился

Код:
Sub Макрос2()
'
' Макрос2 Макрос
'
'
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "мама"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    Selection.MoveLeft Unit:=wdCharacter, Count:=14
    Selection.MoveRight Unit:=wdCharacter, Count:=29, Extend:=wdExtend
    Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    Selection.Copy
    Windows("Совпадения.docx").Activate
    Windows("Документ2").Activate
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "мама"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindAsk
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    Selection.Find.Execute
    Selection.PasteAndFormat (wdFormatOriginalFormatting)
    Selection.MoveLeft Unit:=wdCharacter, Count:=6
    Selection.MoveRight Unit:=wdCharacter, Count:=28, Extend:=wdExtend
    Selection.Copy
    Windows("Совпадения.docx").Activate
    Selection.PasteAndFormat (wdFormatOriginalFormatting)
    Selection.TypeParagraph
    Windows("Документ2").Activate
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "мама"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindAsk
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    Selection.Find.Execute
    Selection.MoveLeft Unit:=wdCharacter, Count:=16
    Selection.MoveRight Unit:=wdCharacter, Count:=30, Extend:=wdExtend
    Selection.Copy
    Windows("Совпадения.docx").Activate
    Selection.PasteAndFormat (wdFormatOriginalFormatting)
    Selection.TypeParagraph
    Windows("Документ2").Activate
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "мама"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindAsk
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    Selection.Find.Execute
    Selection.Find.Execute
    Selection.Find.Execute
End Sub
Приходится работать с документами, в которых по пару тыс страниц. Вот и прошу помощи. Если возможно, помочь написать код, что бы автоматом сохранение происходило, после того, как ворд найдет искомое слово в очередной строке.
sevik111 вне форума Ответить с цитированием
Старый 07.04.2019, 20:25   #2
Казанский
Старожил
 
Аватар для Казанский
 
Регистрация: 31.12.2010
Сообщений: 2,133
По умолчанию

Текст без форматирования
Код:
Option Compare Text 'в начале модуля

Sub Se()
Dim p As Paragraph
  For Each p In ActiveDocument.Paragraphs
    If p.Range.Text Like "*мама*" Then
      Documents("Совпадения.docx").Range.InsertAfter p.Range.Text
    End If
  Next
End Sub
exceleved@yandex.ru Яндекс.Деньги: 410011500007619
Казанский вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Поиск и копирование в новый документ viperm Microsoft Office Word 3 06.02.2017 09:38
Создать новый документ word в запущенном процессе winword.exe ольгаг Общие вопросы .NET 1 20.10.2013 21:32
Экспорт результатов поиска в новый документ sn00pik Microsoft Office Word 2 14.09.2012 10:47
копирование строк, соответствующих условию фильтра и копирование на новый лист xorek Microsoft Office Excel 0 09.07.2012 18:13
Копирование данных в другой документ с условием oleg544 Microsoft Office Excel 2 05.04.2010 11:12