Поиск и копирование текста.

[paratruper17]

Добрый день, уважаемые форумчане. Пишу достаточно объемную программу по работе с однотипными текстовыми документами и для полного счастья не хватает еще чуть-чуть. А именно:
Однотипный документ представляет из себя следующую последовательность
Процедура №1 "Название"
Цель процедуры: "Цель"
Участники: ""
Входные данные:вход1, вход2, вход3.... и т.д.
Порядок выполнения процедуры:
"Далее идет описание последовательности выполнения процедуры"
Процедура №2 "Название"
далее все идет как и в первой процедуре

Необходимо сделать выборку входных данных (вход1,вход2,вход3) во всех процедурах и помещать каждый в отдельную ячейку создаваемой таблицы
Буду очень признателен, если поможете.

[viter.alex]

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

[paratruper17]

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

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

1)Таблица создается в новом документе doc. Таблица должна состоять из 2-х столбцов, а кол-во строк должно быть равно кол-ву найденных входов.
2) Язык VBA

[viter.alex]

Попробуйте так.

Sub FindAndCopy()
  Dim oCurrDoc As Document: Set oCurrDoc = ActiveDocument 'Текущий документ
  Dim oNewDoc As Document 'Новый документ
  Dim oNewDocTbl As Table 'Таблица в новом документе, в которую будем вносить данные
  Dim oNewDocRng As Range 'Диапазон нового документа, в который будем вставлять таблицу
  Dim sInputData As String 'строка входных данных
  Dim arInputs 'Массив, в который будем преобразовывать строку входных данных
  Dim i As Integer 'Счетчик цикла
  
  Const INPUTDATA = "Входные данные:"
  'Добавляем новый документ
  Set oNewDoc = Documents.Add
  Set oNewDocRng = oNewDoc.Range
  
  'Начинаем поиск
  With oCurrDoc.Range.Find
    .Text = INPUTDATA
    While .Execute
      'Текст абзаца, в котором нашли строку «Входные данные:»
      sInputData = .Parent.Paragraphs(1).Range.Text
      'Убираем из строки знак абзаца, обрамляющие пробелы и «Входные данные:»
      sInputData = Trim(Replace(Replace(sInputData, INPUTDATA, ""), ChrW(13), ""))
      'строку преобразовываем в массив
      arInputs = Split(sInputData, ", ")
      'Перемещаем диапазон для вставки таблицы в конец документа
      oNewDocRng.SetRange oNewDoc.Range.End, oNewDoc.Range.End
      'Добавляем таблицу
      Set oNewDocTbl = oNewDoc.Tables.Add(oNewDocRng, 1, 2)
      'Заполняем таблицу значениями
      For i = 0 To UBound(arInputs)
        With oNewDocTbl
          .Cell(i + 1, 1).Range.Text = arInputs(i)
          'Если не последний элемент массива, то добавляем в таблицу строку
          If i <> UBound(arInputs) Then .Rows.Add
        End With
      Next i
      'Вставляем абзац в конец документа, чтобы разделять таблицы
      oNewDoc.Range.InsertParagraphAfter
    Wend
  End With
End Sub

[paratruper17]

Огромное Вам спасибо!

[paratruper17]

Еще есть небольшой вопросик. Как преобразовать код так, чтобы входы заполнялись в одну таблицу а не в отдельную? (чтобы в создающемся документе была единая таблица без разбиений по процедурам)

[viter.alex]

Вот так изменить:

Sub FindAndCopy()
  Dim oCurrDoc As Document: Set oCurrDoc = ActiveDocument 'Текущий документ
  Dim oNewDoc As Document 'Новый документ
  Dim oNewDocTbl As Table 'Таблица в новом документе, в которую будем вносить данные
  Dim oNewDocRng As Range 'Диапазон нового документа, в который будем вставлять таблицу
  Dim sInputData As String 'строка входных данных
  Dim arInputs 'Массив, в который будем преобразовывать строку входных данных
  Dim i As Integer 'Счетчик цикла
  
  Const INPUTDATA = "Входные данные:"
  'Добавляем новый документ
  Set oNewDoc = Documents.Add
  Set oNewDocRng = oNewDoc.Range
  
  'Перемещаем документ в конец документа
  oNewDocRng.SetRange oNewDoc.Range.End, oNewDoc.Range.End
  'Добавляем таблицу
  Set oNewDocTbl = oNewDoc.Tables.Add(oNewDocRng, 1, 2)
  
  'Начинаем поиск
  With oCurrDoc.Range.Find
    .Text = INPUTDATA
    While .Execute
      'Текст абзаца, в котором нашли строку «Входные данные:»
      sInputData = .Parent.Paragraphs(1).Range.Text
      'Убираем из строки знак абзаца, обрамляющие пробелы и «Входные данные:»
      sInputData = Trim(Replace(Replace(sInputData, INPUTDATA, ""), ChrW(13), ""))
      'строку преобразовываем в массив
      arInputs = Split(sInputData, ", ")
      If oNewDocTbl.Rows.Count > 1 Then oNewDocTbl.Rows.Add
      'Заполняем таблицу значениями
      For i = 0 To UBound(arInputs)
        With oNewDocTbl
          .Cell(.Rows.Count + i, 1).Range.Text = arInputs(i)
          'Если не последний элемент массива, то добавляем в таблицу строку
          If i <> UBound(arInputs) Then .Rows.Add
        End With
      Next i
    Wend
  End With
End Sub

[paratruper17]

Большое спасибо! Я Ваш должник!