Find and Replace Macro

amparete13 · #3 03-10-2014, 10:26 AM

Perfect! That it was I was looking for. Thanks. I did add MatchCase in all the cases where WholeWords was in and now it does works.

I add the code here just in case anyone wants it. Thanks to Shyams ( http://skp.mvps.org/ppt00025.htm )

Now I can change different words at the same time. It is a bit slow, but much faster than manually.

Thanks

Quote:

Sub GlobalFindAndReplace()
Dim oPres As Presentation
Dim oSld As Slide
Dim oShp As Shape
Dim FindWhat As String
Dim ReplaceWith As String

FindWhat = "Motivação"
ReplaceWith = "Motivación"
For Each oPres In Application.Presentations
For Each oSld In oPres.Slides
For Each oShp In oSld.Shapes
Call ReplaceText(oShp, FindWhat, ReplaceWith)
Next oShp
Next oSld
Next oPres

FindWhat = "Crescimento"
ReplaceWith = "Crecimiento"
For Each oPres In Application.Presentations
For Each oSld In oPres.Slides
For Each oShp In oSld.Shapes
Call ReplaceText(oShp, FindWhat, ReplaceWith)
Next oShp
Next oSld
Next oPres

End Sub

Sub ReplaceText(oShp As Object, FindString As String, ReplaceString As String)
Dim oTxtRng As TextRange
Dim oTmpRng As TextRange
Dim I As Integer
Dim iRows As Integer
Dim iCols As Integer
Dim oShpTmp As Shape

' Always include the 'On error resume next' statememt below when you are working with text range object.
' I know of at least one PowerPoint bug where it will error out - when an image has been dragged/pasted
' into a text box. In such a case, both HasTextFrame and HasText properties will return TRUE but PowerPoint
' will throw an error when you try to retrieve the text.
On Error Resume Next
Select Case oShp.Type
Case 19 'msoTable
For iRows = 1 To oShp.Table.Rows.Count
For iCols = 1 To oShp.Table.Rows(iRows).Cells.Count
Set oTxtRng = oShp.Table.Rows(iRows).Cells(iCols).Shape.TextFram e.TextRange
Set oTmpRng = oTxtRng.Replace(FindWhat:=FindString, Replacewhat:=ReplaceString, WholeWords:=True, MatchCase:=msoTrue)
Do While Not oTmpRng Is Nothing
Set oTmpRng = oTxtRng.Replace(FindWhat:=FindString, _
Replacewhat:=ReplaceString, _
After:=oTmpRng.Start + oTmpRng.Length, _
WholeWords:=True, MatchCase:=msoTrue)
Loop
Next
Next
Case msoGroup 'Groups may contain shapes with text, so look within it
For I = 1 To oShp.GroupItems.Count
Call ReplaceText(oShp.GroupItems(I), FindString, ReplaceString)
Next I
Case 21 ' msoDiagram
For I = 1 To oShp.Diagram.Nodes.Count
Call ReplaceText(oShp.Diagram.Nodes(I).TextShape, FindString, ReplaceString)
Next I
Case Else
If oShp.HasTextFrame Then
If oShp.TextFrame.HasText Then
Set oTxtRng = oShp.TextFrame.TextRange
Set oTmpRng = oTxtRng.Replace(FindWhat:=FindString, _
Replacewhat:=ReplaceString, WholeWords:=True, MatchCase:=msoTrue)
Do While Not oTmpRng Is Nothing
Set oTmpRng = oTxtRng.Replace(FindWhat:=FindString, _
Replacewhat:=ReplaceString, _
After:=oTmpRng.Start + oTmpRng.Length, _
WholeWords:=True, MatchCase:=msoTrue)
Loop
End If
End If
End Select
End Sub

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Is the following too complex for find/replace macro?	bertietheblue	Word VBA	12	11-04-2013 05:35 PM
Find - Replace Macro using a table list	mdw	Word	0	08-01-2013 04:36 PM
Find and Replace Format macro issue	Jack	Word VBA	2	12-12-2012 09:24 PM
macro or find/replace	JamesVenhaus	Word	2	02-27-2012 03:34 PM
Find and Replace Macro - A Better Way	Tribos	Word VBA	0	10-08-2008 03:22 AM