"Нарезка" текста

[kapitel_bc@ukr.net]

Уважаемые знатоки. Помогите дописать макрос.
Имеются документы с текстом разбитым по 10 параграфов в каждом,

Параграф1
Текст текст текст…. Текст
Параграф2
Текст текст текст…. Текст
Параграф3
Текст текст текст…. текст
……..
Параграф10
Текст текст текст…. текст
необходимо нарезать текст по параграфам и вставить в файлы в файлы word , например, под именами 01.doc (для Параграфов1), 02.doc (для Параграфов2) и т.д.
¬

Этот макрос выделяет фрагменты

Sub FindWords( _
ByRef strWord1 As String, _
ByRef strWord2 As String)
Dim rng As Range
Static rngTemp As Range

Set rng = ActiveDocument.Content

With rng.Find
.ClearFormatting
.Text = strWord1
.Forward = True
.Wrap = wdFindContinue
.MatchWholeWord = True
.MatchCase = False
.Execute
If .Found = True Then
If rngTemp Is Nothing Then
Set rngTemp = rng
FindWords strWord2, strWord1
Else
rng.SetRange rngTemp.Start, rng. Start
rng.Select
Set rngTemp = Nothing
End If
End If
End With
End Sub
----------------------------------------------------
Sub Параграф1()
FindWords " Параграф1", " Параграф2"
End Sub
--------------------------------------------------
Sub Параграф2()
FindWords " Параграф2", " Параграф3"
End Sub

[viter.alex]

Вы как-то очень хитро подошли к этому вопросу. Вам нужно:

1. Найти первую строку, которая ограничивает группу абзацев сверху. Запомнить начало следующего за этой строкой абзаца
2. Найти вторую строку, которая ограничивает группу абзацев снизу. Запомнить конец предыдущего этой строке абзаца
3. Взять диапазон, ограниченных запомненными значениями начала и конца и скопировать его в буфер
4. Создать новый документ и вставить содержимое буфера

Поскольку для последней группы абзацев нет строки, ограничивающей группу снизу, то нужно передавать пустую строку и выделять диапазон до конца документа
Примерно так:

Sub FindWords(ByVal FirstLine As String, ByVal SecondLine As String)
  Dim iStart As Long, iEnd As Long
  
  'Ищем первое слово
  With ActiveDocument.Content.Find
    .Text = FirstLine
    .Execute
    If .Found Then
      iStart = .Parent.Paragraphs.First.Next.Range.Start
    Else
      MsgBox "Не найдено начало группы """ & FirstLine & """.", vbInformation + vbSystemModal
      Exit Sub
    End If
  End With
  
  'Если второе слово не пустое, то ищем его, иначе запоминаем конец документа
  If SecondLine <> "" Then
    With ActiveDocument.Content.Find
      .Text = SecondLine
      .Execute
      If .Found Then
        iEnd = .Parent.Paragraphs.First.Previous.Range.End
      Else
        MsgBox "Не найден конец группы """ & SecondLine & """.", vbInformation + vbSystemModal
        Exit Sub
      End If
    End With
  Else
    iEnd = ActiveDocument.Content.End
  End If
  'Выделяем нужный диапазон
  ActiveDocument.Range(iStart, iEnd).Select
End Sub

[kapitel_bc@ukr.net]

Сообщение от viter.alex

Вы как-то очень хитро подошли к этому вопросу. Вам нужно:[LIST=1][*]Найти первую строку, которая ограничивает группу абзацев сверху. Запомнить начало следующего за этой строкой абзаца
[/color][/CODE]

Александр, здравствуйте.
Все правильно, только в первом нужно: "Найти первую строку, которая ограничивает группу абзацев сверху. Запомнить (но лучше вырезать, что бы не создавал лишней путаницы)" и
Открыть существующий документ и вставить в него соответствующий фрагмент.
Соответствие: Фрагмент который начинается фразой "Параграф1" в 01.doc, фрагмент "Параграф2" - 02.doc и т.д.

[kapitel_bc@ukr.net]

Всем спасибо! Сам прозрел