PDA

View Full Version : Replace paragraph with two paragraphs



Yuri
01-30-2016, 12:10 AM
Halllo everybody.
Please, answer my question. I have a document and there are paragraphs having style 'Style1'. I need to insert after every such paragraph a new paragraph with style 'Style2' and with definite text (e.g., 'New text').
I wrote a VBA macro to do this replacements but it works slowly because I have to scan all the paragraphs, determine style, insert paragraph, etc.
Is there a solution jf my problem based on Word's Find/Replace operation (or several sequential operations)? I need VBA code that can demonstrate the solution.

gmayor
01-30-2016, 12:31 AM
I think you will find the following fast enough
Option Explicit
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

Yuri
01-30-2016, 12:44 AM
Graham, your solution is really fast, thank you very much. Still, is there a way to avoid loops and do the task with 1-2 Find/Replace operations (I guess, regular expressions should be used).

akuini
01-30-2016, 07:22 AM
Hi, Yuri
You may try this code. It doesn’t use loop. But I don’t know it will be faster or not.
It has 2 steps:


Find paragraph mark (^p) having style1 and replace with a ^p + some unique text + ^p. I use “@@” for the unique text, you may change that.
Find “@@^p” and change to “New Text^p” and change the style to style2.



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

Yuri
02-01-2016, 02:29 AM
Akuinu, great thanks, your code is what I expected. In my sample document, my code runs in 20 seconds, Graham's in 8 seconds, and yours in 2 seconds.

gmayor
02-01-2016, 05:16 AM
Use those six seconds wisely!