Find and Replace Macro

[amparete13]

Hi, Nice forum!



I am trying to translate some presentations, so I would like to make a macro, with several words that I do know they are in all presentations, so that it translate those words automatically.

I have been looking at https://www.msofficeforums.com/power...place-vba.html but it does have the problem that it does not difference between capital letters and not. For example if I want to replace "How" but not "how" it does not work properly.

Can anyone help me to solve this problem?

Thanks in advanced,

[JohnWilson]

Where you see

Replacewhat:=ReplaceString, WholeWords:=True) (several places)

Use

Replacewhat:=ReplaceString, WholeWords:=True, MatchCase:=msoTrue)

The replace will only happen if the case is exactly the same.

There'a a typo in Shyams code BTW

Col should be Cols (2 places)

[amparete13]

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

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

[amparete13]

I have tried with 50 words at the same time and it does collapse.

¿Is there any way to make the code cleaner so that I can change at the same time a big amount of words?

Thanks!