"Find and Replace" in PowerPoint using Excel VBA

[smit3446]

The title is pretty self explanatory. Any idea how to do this? Here's the code I have so far which calls some functions to paste excel charts into the PowerPoint:

Sub ExcelToPres()

Dim PPT As PowerPoint.Application
Dim MyPPT As PowerPoint.Presentation


Set PPT = New PowerPoint.Application
PPT.Visible = True
Set MyPPT = PPT.Presentations.Open(Filename:="H:\HC Assignments\Macros\State Study Template.pptx")
Dim State_Name As String
Dim Directory_File As String


copy_chart "Sheet1", 3, "Chart 1"
copy_range "Sheet1", 2, "A1:B3"
copy_group "Sheet1", 2, "Group 4"


State_Name = Worksheets("Sheet1").range("A1").Value


Directory_File = "H:\Test\" & State_Name & ".pptx"
MyPPT.SaveAs Directory_File


End Sub

I need to replace any instance of the string "_STATE_" with my variable, State_Name.


​Thanks!

 

[Worf]

Where exactly are the strings to be replaced?

' Excel module
Sub SlidesAndTables()
Dim sld As Slide, objppt As powerpoint.Application, shp As powerpoint.Shape, _
act As Presentation, i%, j%, sname, n$
Set objppt = CreateObject("PowerPoint.Application")
Set act = objppt.ActivePresentation
sname = Worksheets("Sheet1").[a1]
n = "_STATE_"
For Each sld In act.Slides
    For Each shp In sld.Shapes
        If shp.HasTextFrame Then
            If shp.TextFrame.HasText Then shp.TextFrame.TextRange.Text = _
            Replace(shp.TextFrame.TextRange.Text, n, sname)
        End If
        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, n, sname)
            Next j, i
        End If
    Next
Next
End Sub

 

[smit3446]

This worked perfectly - thank you!

 

[Worf]

You are welcome!

 

[objectnote]

is there a way to find and replace in powerpoint using a list of words in one column in excel and replacing it with another list of words?

 

[Worf]

Like this

' Excel module
Sub SlidesAndTables()
Dim sld As Slide, objppt As PowerPoint.Application, shp As PowerPoint.Shape, _
act As Presentation, i%, j%, k%
Set objppt = CreateObject("PowerPoint.Application")
Set act = objppt.ActivePresentation
For k = 1 To [a1].End(xlDown).Row
For Each sld In act.Slides
    For Each shp In sld.Shapes
        If shp.HasTextFrame Then
            If shp.TextFrame.HasText Then shp.TextFrame.TextRange.Text = _
            Replace(shp.TextFrame.TextRange.Text, Cells(k, 1), Cells(k, 2))
        End If
        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, Cells(k, 1), Cells(k, 2))
            Next j, i
        End If
    Next
Next
Next
End Sub