Thread: [Solved] Find and Replace Macro
View Single Post
 
Old 03-10-2014, 10:26 AM
amparete13 amparete13 is offline Windows 7 64bit Office 2013
Novice
 
Join Date: Mar 2014
Posts: 4
amparete13 is on a distinguished road
Default

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
Reply With Quote