1 Тема от yshindin

  • yshindin
  • генерал-полковник
  • Неактивен
  • Откуда: Москва
  • Зарегистрирован: 12.05.2012
  • Сообщений: 447
  • Поблагодарили: 171

Тема: Заменить абзац на два абзаца

Добрый день.
Подскажите, кто сталкивался с подобной задачей.
Есть в документе абзацы, имеющие стиль абзаца Style1. Необходимо после каждого такого абзаца добавить абзац в стиле абзаца Style2, содержащего определенный текст. Эту задачу необходимо реализовать через операцию поиска/замены Word.

Сайтyshindin

2 Ответ от yshindin

  • yshindin
  • генерал-полковник
  • Неактивен
  • Откуда: Москва
  • Зарегистрирован: 12.05.2012
  • Сообщений: 447
  • Поблагодарили: 171

Re: Заменить абзац на два абзаца

yshindin пишет:

Добрый день.
Подскажите, кто сталкивался с подобной задачей.
Есть в документе абзацы, имеющие стиль абзаца Style1. Необходимо после каждого такого абзаца добавить абзац в стиле абзаца Style2, содержащего определенный текст. Эту задачу необходимо реализовать через операцию поиска/замены Word.

Я задал этот вопрос на форуме VBAExpress ( внешняя ссылка ). Сналала Graham Mayor предложил VBA-решение, которое несколько быстрее моего:
Sub Example()
    Dim oRng As Range, oNext As Range
    Const strStyle1 As String = "Style1"
    Const strStyle2 As String = "Style2"
    Const strText As String = "New Text"
    Set oRng = ActiveDocument.Range
    With oRng.Find
        .Style = strStyle1
        Do While .Execute
            oRng.InsertParagraphAfter
            Set oNext = oRng.Paragraphs(1).Range.Next
            oNext.Style = strStyle2
            oNext.End = oNext.End - 1
            oNext.Text = strText
            oRng.Collapse 0
        Loop
    End With
lbl_Exit:
    Exit Sub
End Sub

Потом некто  akuini предложил вариант, который мне был нужен:
Sub addStyle()
    Dim r As Range
     
    Set r = ActiveDocument.Range
    With r.Find
        .Style = "Style1"
        .Execute Findtext:="^p", ReplaceWith:="^p@@^p", _
        Replace:=wdReplaceAll, Forward:=True
    End With
     
    Set r = ActiveDocument.Range
    With r.Find
        .Style = "Style1"
        .Replacement.Style = "Style2"
        .Execute Findtext:="@@^p", ReplaceWith:="New text^p", _
        Replace:=wdReplaceAll, Forward:=True
    End With
     
End Sub

Привлекательность последнего решения в том, что  оно не зависит от числа абзацев напрямую (т.е., при большом числе абзацев в стиле Style1 оно будет быстрее первого решения).

Сайтyshindin