PPT Replace method

[John Svendsen]

Hi All,

I have a macro that substitutes one string for another in PPT - however, if
there are 2 or more occurences of the same string in a same shape, only the
1st occurence is replaced, not the others.

Below is the piece of my replace code:

=========================================
If shp.HasTextFrame Then
If shp.TextFrame.HasText Then
shp.TextFrame.TextRange.Replace FindWhat:=sFirst, _
Replace:=sLast, MatchCase:=True, WholeWords:=True
End If
End If
=========================================

(OBS: word replace has the wdFindContinue in the Wrap property - I do not
see this in PPT, does it exist?)

Thanks in advance for any ideas.

Regards, JS

 

[Steve Rindsberg]

Hi All,

I have a macro that substitutes one string for another in PPT - however, if
there are 2 or more occurences of the same string in a same shape, only the
1st occurence is replaced, not the others.

Below is the piece of my replace code:

=========================================

If shp.HasTextFrame Then
If shp.TextFrame.HasText Then

' Try this instead (works in PPT2000 and up, NOT on PPT97 or PPTMac)
shp.TextFrame.Text = Replace(shp.TextFrame.Text, _
"Text to find", "Text to replace it with")

' shp.TextFrame.TextRange.Replace FindWhat:=sFirst, _
' Replace:=sLast, MatchCase:=True, WholeWords:=True
End If
End If

 

[John Svendsen]

Hi Steve,

Thanks again for your reply.

Question: this new method complained about "MatchCase:=True,
WholeWords:=True", and this is something I need to have.

Is there a way around this?

Againg, Tks, JS

 

[Steve Rindsberg]

Hi Steve,

Thanks again for your reply.

Question: this new method complained about "MatchCase:=True,
WholeWords:=True", and this is something I need to have.

Is there a way around this?

Yes. When I posted my reply, that line was commented out.
Leave it commented out and PPT will stop barking at you. ;-)

In other words, it should look like this:

If shp.HasTextFrame Then
If shp.TextFrame.HasText Then
shp.TextFrame.Text = Replace(shp.TextFrame.Text, _
"Text to find", "Text to replace it with")
End If
End If

It'd be wise to include a bit of error handling around the line that does the
Replace. PowerPoint has a few odd bugs that allow a shape to pass the first
two IF tests but still error out when you try to access the text. More like
this:

Sub Whatever()

On Error GoTo ErrorHandler

If shp.HasTextFrame Then
If shp.TextFrame.HasText Then
On Error Resume Next
shp.TextFrame.Text = Replace(shp.TextFrame.Text, _
"Text to find", "Text to replace it with")
On Error GoTo ErrorHandler
End If
End If

NormalExit:
Exit Sub
ErrorHandler:
' msg box or log it or ignore it
Resume NormalExit

End Sub

 

[Steve Rindsberg]

Hi Steve,

Thanks again for your reply.

Question: this new method complained about "MatchCase:=True,
WholeWords:=True", and this is something I need to have.

Is there a way around this?

Oops. Misunderstood (or at least misanswered) your question. ;-)

OK, play with this a bit:

Sub TryThis()

Dim shp As Shape
Dim sFind As String
Dim sReplaceWith As String
Dim x As Long

Set shp = ActiveWindow.Selection.ShapeRange(1)
sFind = "text to find"
sReplaceWith = "text to replace it with"
x = 1

If shp.HasTextFrame Then
If shp.TextFrame.HasText Then

While x < Len(shp.TextFrame.TextRange)
' find the next occurrence of the Find string:
x = InStr(x, shp.TextFrame.TextRange.Text, sFind, vbBinaryCompare)
If x > 0 Then ' found one, try the replace on it
' notice that it's supposed to be ReplaceWhat:=
' rather than Replace:=
shp.TextFrame.TextRange.Replace FindWhat:=sFind, _
ReplaceWhat:=sReplaceWith, MatchCase:=True, WholeWords:=True
Else ' none found, we're done, leave.
Exit Sub
End If
' increment x so we don't keep finding the same string over and over
x = x + 1
Wend

End If
End If

End Sub

 

[John Svendsen]

Hey Steve,

Cool!!!



Tks so much!!

JS

Oops. Misunderstood (or at least misanswered) your question. ;-)

OK, play with this a bit:

Sub TryThis()

Dim shp As Shape
Dim sFind As String
Dim sReplaceWith As String
Dim x As Long

Set shp = ActiveWindow.Selection.ShapeRange(1)
sFind = "text to find"
sReplaceWith = "text to replace it with"
x = 1

If shp.HasTextFrame Then
If shp.TextFrame.HasText Then

While x < Len(shp.TextFrame.TextRange)
' find the next occurrence of the Find string:
x = InStr(x, shp.TextFrame.TextRange.Text, sFind, vbBinaryCompare)
If x > 0 Then ' found one, try the replace on it
' notice that it's supposed to be ReplaceWhat:=
' rather than Replace:=
shp.TextFrame.TextRange.Replace FindWhat:=sFind, _
ReplaceWhat:=sReplaceWith, MatchCase:=True, WholeWords:=True
Else ' none found, we're done, leave.
Exit Sub
End If
' increment x so we don't keep finding the same string over and over
x = x + 1
Wend

End If
End If

End Sub

 

[Steve Rindsberg]

Hey Steve,

Cool!!!



Tks so much!!

My pleasure. Learned a few new tricks in the process ...

 

[Shyam Pillai]

John,
Take a look at this Find and Replace routine for PowerPoint -
http://skp.mvps.org/ppt00025.htm#2