Word VBA: Макрос на удаление текста между двумя горизонтальными линиями

[djzhenia]

Доброго времени суток.

Есть файл (пример файла прикреплён). Нужен макрос который бы убирал все что между двумя горизонтальными строками и сроку выше.
В прикреплённом файле макрос должен удалять текст начиная с "Журнал "Самиздат":" и заканчивая второй горизонтальной линией.

Спасибо.

[вложение удалено администратором]

[Администратор]

Макрос

Sub Main()

    Dim docAct As Word.Document, inlineshp As Word.InlineShape, i As Long
    Dim parFirst As Word.Paragraph, parSecond As Word.Paragraph
   
   
    '1. Vba-именование активного ворд-файла (чтобы не писать длинное слово "ActiveDocument").
    Set docAct = ActiveDocument
   
    '2 Движение по всем инлайншейпам в поисках первой горизонтальной линии.
    For i = 1 To docAct.InlineShapes.Count Step 1
        Set inlineshp = docAct.InlineShapes(i)
        If inlineshp.Type = wdInlineShapeHorizontalLine Then
            ' Vba-именование абзаца, где находится гориз. линия.
            Set parFirst = inlineshp.Range.Paragraphs(1)
            Exit For
        End If
    Next i
   
    '3. Движение по оставшимся инлайншейпам в поисках второй горизонтальной линии.
    For i = i + 1 To docAct.InlineShapes.Count Step 1
        Set inlineshp = docAct.InlineShapes(i)
        If inlineshp.Type = wdInlineShapeHorizontalLine Then
            ' Vba-именование абзаца, где находится гориз. линия.
            Set parSecond = inlineshp.Range.Paragraphs(1)
            Exit For
        End If
    Next i
   
    '4. Проверка, что были найдены гориз. линии (на всякий случай).
    If parFirst Is Nothing Or parSecond Is Nothing Then
        MsgBox "В файле нет двух горизонтальных линий.", vbExclamation
        Exit Sub
    End If
   
    '5. Удаление фрагмента в файле.
    docAct.Range(parFirst.Previous.Range.Start, parSecond.Range.End).Delete
   
    '6. Сообщение.
    MsgBox "Готово.", vbInformation

End Sub

[свернуть]

[djzhenia]

Отлично, работает, спасибо.