PDA

View Full Version : Find and replace text in Powerpoint from Excel



brenton5
03-21-2012, 11:50 AM
I successfully used this code with just powerpoint, but when I move it inside my excel module it gives me several problems. I embedded the Powerpoint application on sheet 1 of Excel. The goal is to replace the company name whenever it appears on a powerpoint slide with the new company name from an excel range.
I get error 429 ActiveX component cant create object at the red line. Is my Powerpoint presentation not active? Any help would be appreciated. Using excel/Powerpoint 2010.

Sub changeme(sFindMe As String, sSwapme As String)
Dim osld As Slide
Dim oshp As Shape
Dim otemp As TextRange
Dim otext As TextRange
Dim Inewstart As Integer



For Each osld In ActivePresentation.Slides
For Each oshp In osld.Shapes
If oshp.HasTextFrame Then
If oshp.TextFrame.HasText Then

Set otext = oshp.TextFrame.TextRange
Set otemp = otext.Replace(sFindMe, sSwapme, , msoFalse, msoFalse)
Do While Not otemp Is Nothing
Inewstart = otemp.Start + otemp.Length
Set otemp = otext.Replace(sFindMe, sSwapme, Inewstart, msoFalse, msoFalse)
Loop

End If
End If

Next oshp
Next osld
End Sub
'-------------------------------------------------------------------------
Sub swap()
Dim sFindMe As String
Dim sSwapme As String
Dim ppApp As PowerPoint.Application
Dim ppPreso As PowerPoint.Presentation

'Start Powerpoint

'Look for existing instance
On Error Resume Next
Set ppApp = GetObject(, "PowerPoint.Application")
On Error GoTo 0

'Create new instance if no instance exists
Set ppApp = CreateObject("Powerpoint.Application")



'Open Template in word
With Sheets("Sheet1").Shapes("Object 1").OLEFormat.Verb(Verb:=xlVerbOpen)
End With
'Make it visible
ppApp.Visible = True



sFindMe = "Name To Find"
'change this to suit
sSwapme = "New Name"
Call changeme(sFindMe, sSwapme)
'sFindMe = "<find2>"
'sSwapme = ActivePresentation.Slides(1).Shapes(2).TextFrame.TextRange
'Call changeme(sFindMe, sSwapme)
End Sub

Kenneth Hobs
03-21-2012, 12:56 PM
Welcome to the forum!

PPT is contained in the OLEObject, it is not a separate object as you are trying to treat it as one normally does. What you might want to do is to post very short example files when you get 5 posts or post to a site like box.net.

For now, see if the concept that I used for an MSWord in an OLEObject can be adapted for your scenario.

Sub OpenADoc()
Dim mpWord As Object
Dim mpDoc As Object

ActiveSheet.OLEObjects("aDoc").Verb xlPrimary
Do
Set mpWord = GetObject(, "Word.Application")
mpWord.Visible = True
Set mpDoc = mpWord.ActiveDocument
Loop Until Not mpDoc Is Nothing

With mpDoc
.Range(.Content.Start, .Content.End).Copy
End With

mpDoc.Close
mpWord.Quit
Set mpDoc = Nothing
Set mpWord = Nothing

Worksheets("Sheet3").Paste
End Sub

brenton5
03-21-2012, 01:45 PM
Ken thanks for the response and warm welcome. Not sure I understand how that word object info would help me.
Ive already had success opening the OLEobject like this, but I just can't loop through all the slides and shapes looking for the text I want replaced.

I had success with the word method, saying "replace the first word in the first shape with the new word". But as you can see if i have to look through paragraphs i don't want to count out what number the word that i want to change is, so i would rather loop through the slides and shapes looking to replace the text.

Here is what I have that works using the "word" method. Any tips on how to adjust that logic for search and replace? This logic appears in the attached file. Like i said it works but it is just not ideal coding

Sub GeneratePPT()


Dim ppApp As PowerPoint.Application
Dim ppSlide As PowerPoint.Slide
Dim rngText As TextRange


'Start Powerpoint

'Look for existing instance
On Error Resume Next
Set ppApp = GetObject(, "PowerPoint.Application")
On Error GoTo 0

'Create new instance if no instance exists
Set ppApp = CreateObject("Powerpoint.Application")



'Open Template in word
With Sheets("Sheet1").Shapes("Object 1").OLEFormat.Verb(Verb:=xlVerbOpen)
End With
'Make it visible
ppApp.Visible = True


'First Slide
'Sets current slide to active slide
ppApp.ActiveWindow.View.GotoSlide ppApp.ActivePresentation.Slides.Count
Set ppSlide = ppApp.ActiveWindow.View.Slide

'shape 1 is first text box replace only first word

Set rngText = ppSlide.Shapes(1) _
.TextFrame.TextRange.Words(Start:=1, Length:=1)
rngText.Text = "New Company Name"
AppActivate ("Microsoft PowerPoint")


Set ppSlide = Nothing
Set ppApp = Nothing
End Sub

Kenneth Hobs
03-21-2012, 01:51 PM
This is the key to get the object assigned properly:
ActiveSheet.OLEObjects("aDoc").Verb xlPrimary
Just change aDoc to the OLEObject's name. Then we can play with the other parts to see what is needed.

If your code worked on a separate PPT then we should be able to adapt that to the embedded object.

brenton5
03-21-2012, 02:14 PM
This is the key to get the object assigned properly:
ActiveSheet.OLEObjects("aDoc").Verb xlPrimary
Just change aDoc to the OLEObject's name. Then we can play with the other parts to see what is needed.

If your code worked on a separate PPT then we should be able to adapt that to the embedded object.

Ken did you see the attached file? When I open the embedded powerpoint with your method. It just opens up in slideshow mode. The way I have been opening embedded word documents with success is as follows as well. I just can't get any combination of the search and replace to work.

With Sheets("Sheet1").Shapes("Object 1").OLEFormat.Verb(Verb:=xlVerbOpen)
End With

Kenneth Hobs
03-21-2012, 02:19 PM
I will look at your file later tonight.

brenton5
03-21-2012, 02:31 PM
great, thanks. I have been automating word for a while now, but this is my first venture into automating powerpoint from excel. Word was so much easier! I found great examples of how to bring a chart and images into the powerpoint presentation from excel, but this finding text inside of text boxes is a pain. Most of the examples are just building a powerpoint presentation from excel, and not using a template to change out individual words.

Kenneth Hobs
03-22-2012, 10:55 AM
I only tested the routine in your attachment. If you like, I can test the routine in your first post to change the text in all textbox controls for all slides.

If I get time, I will see if there is a better way to make sure that you get the right instance of PowerPoint for the opened OLEObject.

' http://www.vbaexpress.com/forum/showthread.php?t=41465
Sub GeneratePPT()
Dim ppApp As PowerPoint.Application
Dim ppSlide As PowerPoint.Slide
Dim rngText As TextRange

'Start Powerpoint

'Look for existing instance
' On Error Resume Next
' Set ppApp = GetObject(, "PowerPoint.Application")
' On Error GoTo 0

'Create new instance if no instance exists
' Set ppApp = CreateObject("Powerpoint.Application")

Set ppApp = Nothing
'Open Template in word
Sheets("Sheet1").Shapes("Object 1").OLEFormat.Verb Verb:=xlVerbOpen

'Set object for ppt ole object:
On Error Resume Next
Do
Set ppApp = GetObject(, "PowerPoint.Application")
Loop Until Not ppApp Is Nothing

'Make it visible
ppApp.Visible = False


'First Slide
'Sets current slide to active slide
ppApp.ActiveWindow.View.GotoSlide ppApp.ActivePresentation.Slides.Count
Set ppSlide = ppApp.ActiveWindow.View.Slide

'shape 1 is first text box replace only first word

Set rngText = ppSlide.Shapes(1) _
.TextFrame.TextRange.Words(Start:=1, Length:=1)
rngText.Text = "New Company Name"
'AppActivate ("Microsoft PowerPoint")

ppApp.ActivePresentation.Close
ppApp.Quit
Set ppSlide = Nothing
Set ppApp = Nothing
End Sub

Blastness
10-09-2012, 08:59 AM
Hi to everyone!!! I am new on this forum. I have the same problem of Brenton5. I would like to find and replace text in Powerpoint from Excel. It drives me crazy. :) Were you able to solve the problem?