PDA

View Full Version : ReplaceAll



marathi.bana
02-27-2009, 03:58 PM
I want to creat macro for ReplaceAll. I got code from help.

Code:


Sub ReplaceText()

Dim oSld As Slide
Dim oShp As Shape
Dim oTxtRng As TextRange
Dim oTmpRng As TextRange

Set oSld = Application.ActivePresentation.Slides(1)

For Each oShp In oSld.Shapes
Set oTxtRng = oShp.TextFrame.TextRange
Set oTmpRng = oTxtRng.Replace(FindWhat:="like", _
Replacewhat:="NOT LIKE", WholeWords:=True)
Do While Not oTmpRng Is Nothing
Set oTxtRng = oTxtRng.Characters(oTmpRng.Start + oTmpRng.Length, _
oTxtRng.Length)
Set oTmpRng = oTxtRng.Replace(FindWhat:="like", _
Replacewhat:="NOT LIKE", WholeWords:=True)
Loop
Next oShp

End Sub

But this code not replace all the 'like'.

Example:

1) I like mangoes and I like apple and I like orange
2) I like India and I like US and I like UK
3) I like Cricket and I like Football and I like Tennis


When I run the above macro, I get output as follows

1) I NOT LIKE mangoes and I NOT LIKE apple and I NOT LIKE orange
2) I like India and I like US and I NOT LIKE UK
3) I like Cricket and I like Football and I like Tennis



All the 'like' not replace by 'not like'

Can somebody help me to create macro to replace all the 'like' in the sentence as well as in whole presentation.

The output should be
1) I NOT LIKE mangoes and I NOT LIKE apple and I NOT LIKE orange
2) I NOT LIKE India and I NOT LIKE US and I NOT LIKE UK
3) I NOT LIKE Cricket and I NOT LIKE Football and I NOT LIKE Tennis



I want to replace all "like" just in single click.

Can you please help me? :(

Thanks

venkat1926
03-07-2009, 07:00 PM
will not something like this code help


ActiveSheet.UsedRange.Replace What:="like", Replacement:="not like", LookAt:=xlPart

John Wilson
03-08-2009, 10:49 AM
Not in PowerPoint it won't!

John Wilson
03-08-2009, 01:43 PM
Try this (adapted from code by Shyam Pillai)

Sub FindAndReplace()
Dim oSld As Slide
Dim oShp As Shape
Dim oTxtRng As TextRange
Dim oTmpRng As TextRange
On Error Resume Next
Set oSld = ActivePresentation.Slides(1)
For Each oShp In oSld.Shapes
If oShp.HasTextFrame Then
If oShp.TextFrame.HasText Then
Set oTxtRng = oShp.TextFrame.TextRange
Set oTmpRng = oTxtRng.Replace(FindWhat:="Like", _
Replacewhat:="Not Like", WholeWords:=True)
Do While Not oTmpRng Is Nothing
Set oTmpRng = oTxtRng.Replace(FindWhat:="Like", _
Replacewhat:="Not Like", _
After:=oTmpRng.Start + oTmpRng.Length, _
WholeWords:=True)
Loop
End If
End If
Next oShp
End Sub

marathi.bana
03-09-2009, 06:05 AM
Thanks, it's working.

Thanks once again for your help.

enfantter
10-07-2009, 01:28 AM
Hi just found this post which applies to a similar problem i have.

One minor deviation though. In the word to look for could be any one word in an array - is that possible to incorporate it in the above code ?!

John Wilson
10-07-2009, 03:36 AM
Not really but this might work (change the name of the array and replace and find text of course)
Sub find_replace()
Dim i As Integer
Dim strText As String
Dim strTempText As String
Const replacewhat As String = "John"
Const replacewith As String = "William"
For i = LBound(myRay) To UBound(myRay)
strText = myRay(i)
strTempText = Replace(strText, replacewhat, replacewith, 1)
Do While InStr(strTempText, replacewhat) > 0
strTempText = Replace(strText, replacewhat, replacewith, 1)
Loop
myRay(i) = strTempText
Next i
End Sub

enfantter
03-24-2010, 01:20 AM
Maybe i dont get this - or maybe i didnt explain very well ...
My wish is to have i an array i wish to have four words to look for (kilde, Kãlla, Lähde) and replace with "source"

The above code is entirely looking for "John" right?!

John Wilson
03-24-2010, 01:38 AM
I misunderstood

Maybe something like this:

Sub FindAndReplace()
Dim oSld As Slide
Dim oShp As Shape
Dim oTxtRng As TextRange
Dim oTmpRng As TextRange
Dim strReplace As String
Dim i As Integer
Dim myRay(1 To 4) As String
myRay(1) = "kilde"
myRay(2) = "Kãlla"
myRay(3) = "Lähde"
On Error Resume Next
Set oSld = ActivePresentation.Slides(1)
For Each oShp In oSld.Shapes
If oShp.HasTextFrame Then
If oShp.TextFrame.HasText Then
For i = LBound(myRay) To UBound(myRay)
strReplace = myRay(i)
Set oTxtRng = oShp.TextFrame.TextRange
Set oTmpRng = oTxtRng.Replace(FindWhat:=strReplace, _
replacewhat:="source", WholeWords:=True)
Do While Not oTmpRng Is Nothing
Set oTmpRng = oTxtRng.Replace(FindWhat:=strReplace, _
replacewhat:="source", _
After:=oTmpRng.Start + oTmpRng.Length, _
WholeWords:=True)
Loop
Next i
End If
End If
Next oShp
End Sub

enfantter
03-24-2010, 05:27 AM
this appears to be exactly what i mean !
unfortunatly i cant get it to work and i have no clue about why not (no debug)

i run it seperatly from any other subs

doesnt anybody else have experience with this ..

John Wilson
03-24-2010, 07:37 AM
As written it would only search slide 1 - could this be the problem?

Paul_Hossler
03-26-2010, 05:41 PM
I'm curious as to how / why I'd want to do a S&R via VBA. Everytime I've needed to do something like that, it's been ad hoc, and I just do it from the keyboard.

Maybe my PP needs are much simpler, but I don't want to miss an oppurtunity to see if there's a better way to do something.

Paul