Powerpoint - Replace multiple strings with multiple values

[Jagjag90]

Hi All,

15350

Attached is a sample powerpoint slide where there are several text boxes (and/or tables) that have several different strings within them. I am using Powerpoint 2013.
I have been trying to come up with a VBA solution where for each unique string i can replace it with a unique value
e.g.
Replace {#1#NotionalCurr} with ${'Notional1'}$
and replace {#1#NotionalCurr2} with ${'NotionalAmount3'}$
and....

Within each powerpoint (attached is only one slide) there are multiple instances of the strings and i would need to replace them all. Additionally there are multiple powerpoints so i need to just have some VBA i can run in multiple files (i would open each one and run manually in each, as have to do some other checks in them anyway).

For word it was easy but for powerpoint it's proving almost intractable for me (very novice at VBA, usually just find what i need as sample code elsewhere online and change a few variables to fit).
I have looked for any/all sample code including "skp . mvps . org/ppt00025 . htm#2" (remove spaces, won't let me post otherwise) but none of it is able to do what i need. Problem with the Shyam code is not only can it not handle multiple replacements, but it doesn't seem to work with finding strings like #1#NotionalCurr.

Any help anyone can offer would be greatly appreciated.

[John Wilson]

I haven't got time to work on this right now but I would be fairly sure that the code doesn't work because Shyam set WholeWords: to True. Normally this is good but I don'rt think the symbols you use are seen as part of a "whole word" Start by setting them all to False. To replace more than one thing run the code in a loop with the Find What and Replace What in Arrays that increment.

[Jagjag90]

Hi John,

I tried messing with WholeWords already, still didn't help sadly - but there is every chance i'm just inept and missed something....

[Jagjag90]

Hi,

I think i may have solved it with John's instructions.
I think i had missed a couple of the WholeWords tags, and then i've introduced an array (not an efficient VBA i guess) but i think will do the job, seems to run ok so far.

I will double check it all and if it works as required for everything i'll close this post.

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

Dim myArray As Variant
Dim myArray2 As Variant
Dim x As Integer

myArray = Array("Chance", "Risiko") 'define array
myArray2 = Array("Chance1", "Risiko1")
For x = LBound(myArray) To UBound(myArray) 'define start and end of array

FindWhat = myArray(x)
ReplaceWith = myArray2(x)
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

Next x ' Loop!
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' statement 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 iCol = 1 To oShp.Table.Rows(iRows).Cells.Count
Set oTxtRng = oShp.Table.Rows(iRows).Cells(iCol).Shape.TextFrame.TextRange
Set oTmpRng = oTxtRng.Replace(FindWhat:=FindString, _
Replacewhat:=ReplaceString, WholeWords:=False)
Do While Not oTmpRng Is Nothing
Set oTmpRng = oTxtRng.Replace(FindWhat:=FindString, _
Replacewhat:=ReplaceString, _
After:=oTmpRng.Start + oTmpRng.Length, _
WholeWords:=False)
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:=False)
Do While Not oTmpRng Is Nothing
Set oTmpRng = oTxtRng.Replace(FindWhat:=FindString, _
Replacewhat:=ReplaceString, _
After:=oTmpRng.Start + oTmpRng.Length, _
WholeWords:=False)
Loop
End If
End If
End Select
End Sub