Find and replace a list of words in PowerPoint presentation, including tables

[celinedhrn]

Hi all,

I have been trying to solve this issue for a couple of days and am very stuck despite googling around a lot, so would really appreciate any pointers :)


So I am trying to replace a list of words by another (my file is a template used for several projects). It worked all right in textboxes, but did not work for tables so I have tried to adjust the textboxes code to tables. The below code runs without giving me an error message, but still does not edit my tables...


Thank you in advance for your help!


Celine



Sub Multi_FindReplace()


'PURPOSE: Find & Replace a list of text/values throughout entire PowerPoint presentation


Dim sld As Slide
Dim shp As Shape
Dim ShpTxt As TextRange
Dim TmpTxt As TextRange
Dim FindList As Variant
Dim ReplaceList As Variant
Dim x As Long
Dim i As Long
Dim j As Long
Dim tbl As Table




' INSERT THE LIST OF MERGE FIELDS HERE
FindList = Array("word1", "word2", "word3")


' INSERT THE LIST OF VARIABLES TO BE INSERTED BY HERE
ReplaceList = Array("word1.1", "word2.1", "word3.1")




'Loop through each slide in Presentation
For Each sld In ActivePresentation.Slides


For Each shp In sld.Shapes


'''''for tables
If shp.HasTable Then


'give name to table
Set tbl = shp.Table


'loops on table rows and columns
For i = 1 To shp.Table.Rows.Count
For j = 1 To shp.Table.Columns.Count


'Store cell text into a variable
ShpTxt = tbl.Cell(i, j).Shape.TextFrame.TextRange




'Ensure There is Text To Search Through
If ShpTxt <> "" Then
For x = LBound(FindList) To UBound(FindList)


'Store text into a variable
'Set ShpTxt = shp.TextFrame.TextRange


'Find First Instance of "Find" word (if exists)
Set TmpTxt = ShpTxt.Replace( _
FindWhat:=FindList(x), _
Replacewhat:=ReplaceList(x), _
WholeWords:=False)


'Find Any Additional instances of "Find" word (if exists)
Do While Not TmpTxt Is Nothing
Set ShpTxt = ShpTxt.Characters(TmpTxt.Start + TmpTxt.Length, ShpTxt.Length)
Set TmpTxt = ShpTxt.Replace( _
FindWhat:=FindList(x), _
Replacewhat:=ReplaceList(x), _
WholeWords:=False)
Loop
Next x
End If




Next j
Next i
Else




''''for all shapes excluding tables
If shp.HasTextFrame Then


'Store shape text into a variable
Set ShpTxt = shp.TextFrame.TextRange


'Ensure There is Text To Search Through
If ShpTxt <> "" Then
For x = LBound(FindList) To UBound(FindList)


'Store text into a variable
'Set ShpTxt = shp.TextFrame.TextRange


'Find First Instance of "Find" word (if exists)
Set TmpTxt = ShpTxt.Replace( _
FindWhat:=FindList(x), _
Replacewhat:=ReplaceList(x), _
WholeWords:=False)


'Find Any Additional instances of "Find" word (if exists)
Do While Not TmpTxt Is Nothing
Set ShpTxt = ShpTxt.Characters(TmpTxt.Start + TmpTxt.Length, ShpTxt.Length)
Set TmpTxt = ShpTxt.Replace( _
FindWhat:=FindList(x), _
Replacewhat:=ReplaceList(x), _
WholeWords:=False)
Loop
Next x
End If


End If


End If


Next shp


Next sld




End Sub


d

[John Wilson]

This should error|:

'Store cell text into a variable

ShpTxt = tbl.Cell(i, j).Shape.TextFrame.TextRange

ShpTxt is declared as a TEXTRANGE OBJECT

SO

'Store cell text into a variable

Set ShpTxt = tbl.Cell(i, j).Shape.TextFrame.TextRange

[celinedhrn]

Hi John,

thank you so much for the fix!
I ran the code again and indeed the error came - no idea why it did not initially.
The code works perfectly with the corrected syntax.

Thanks!!!

Celine



This should error|:

'Store cell text into a variable

ShpTxt = tbl.Cell(i, j).Shape.TextFrame.TextRange

ShpTxt is declared as a TEXTRANGE OBJECT

SO

'Store cell text into a variable

Set ShpTxt = tbl.Cell(i, j).Shape.TextFrame.TextRange