I am attempting to replace the text within a PowerPoint table while preserving the existing PowerPoint table formatting.
Unfortunately, I have been able to find a way to do so. When I run the below code, all of the PowerPoint table text is reverted to size 14. I'd like to preserve the different text sizes within each of the tables, and even within each of the text elements (e.g., footnotes following certain text elements).
Please find my code below.
Sub UpdatePresentation()
Dim i As Long, FindWord As String, ReplaceWord As String, cell As Range
Dim path As String
Dim pres As String
Dim PPT As Object
Set PPT = CreateObject("PowerPoint.Application")
path = "Dashboard Template.pptx"
PPT.Presentations.Open Filename:=path
For Each cell In wsDashboard.Range("E6:F35")
If cell.Value2 <> "" Then
FindWord = cell.Text
ReplaceWord = cell.Offset(0, 2).Text
Debug.Print (FindWord & " " & ReplaceWord)
Call ReplacePresentationText(pres, FindWord, ReplaceWord)
Else
'do nothing
End If
Next cell
End Sub
Function ReplacePresentationText(ByRef PPTPres As Variant, ByVal FindWord As Variant, ByVal ReplaceWord As Variant) As Variant
Dim sld As Object, shp As Object, ShpText As Object, TempText As Object
For Each sld In PPTPres.slides
For Each shp In sld.Shapes
If shp.Hastable Then
For i = 1 To shp.Table.Rows.Count
For j = 1 To shp.Table.Columns.Count
' shp.Table.Rows.Item(i).Cells(j).Shape.TextFrame.TextRange.Text = _
' Replace(shp.Table.Rows.Item(i).Cells(j).Shape.TextFrame.TextRange.Text, FindWord, ReplaceWord) ''USED THIS CODE TO REPLACE THE TEXT FIRST
shp.Table.Rows.Item(i).Cells(j).Shape.TextFrame.TextRange.Paragraphs(p).Text = _
Replace(shp.Table.Rows.Item(i).Cells(j).Shape.TextFrame.TextRange.Paragraphs(p).Text, FindWord, ReplaceWord)
Next j
Next i
End If
Next shp
Next sld
End Function
Instead of replacing the .Text property, use the .Replace method on the text container, ex: