Help find and replace in Powerpoint with VBA

[pirespt]

Hi Everyone,

This is my first post and I hope you can help me.

I've been stuck with this for a while now.

In bold is where the code breaks and I don't know how to fix it. Can anyone help?

Here's the code


Sub CreatePowerPoint()<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
<o></o>
'Add a reference to the Microsoft PowerPoint Library by:<o></o>
'1. Go to Tools in the VBA menu<o></o>
'2. Click on Reference<o></o>
'3. Scroll down to Microsoft PowerPoint X.0 Object Library, check the box, and press Okay<o></o>
<o></o>
'First we declare the variables we will be using<o></o>
Dim pptx As PowerPoint.Application<o></o>
Dim activeSlide As Slide<o></o>
Dim cht As Excel.ChartObject<o></o>
<o></o>
'Look for existing instance<o></o>
On Error Resume Next<o></o>
Set pptx = GetObject(, "PowerPoint.Application")<o></o>
On Error GoTo 0<o></o>
<o></o>
'Let's create a new PowerPoint<o></o>
<o></o>
Set pptx = New PowerPoint.Application<o></o>
pptx.Visible = msoCTrue<o></o>
<o></o>
pptx.Presentations.Open Filename:="……………………<o></o>
<o></o>
'Show the PowerPoint & save as the current selection on excel into the outputs folder<o></o>
pptx.Visible = True<o></o>
<o></o>
a = Format(Sheets("Tables").Range("D2").Value, "mmm-yy")<o></o>
<o></o>
b = Sheets("Tables").Range("D4").Value<o></o>
<o></o>
c = Format(Date, "yymmdd")<o></o>
<o></o>
pptx.ActivePresentation.SaveAs Filename:="……………………….. <o></o>
<o></o>
Dim oShp As Shape<o></o>
Dim oTxtRng As TextRange<o></o>
Dim oTmpRng As TextRange<o></o>
Dim strWhatReplace As String, strReplaceText As String<o></o>
<o></o>
' write find text<o></o>
strWhatReplace = "Member"<o></o>
' write change text<o></o>
strReplaceText = "b"<o></o>
<o></o>
' go during each slides<o></o>
For Each activeSlide In pptx.ActivePresentation.Slides<o></o>
' go during each shapes and textRanges<o></o>
For Each oShp In activeSlide.Shapes "it triggers an error 13, type mismatch"
' replace in TextFrame<o></o>
Set oTxtRng = oShp.TextFrame.TextRange<o></o>
Set oTmpRng = oTxtRng.Replace( _<o></o>
FindWhat:=strWhatReplace, _<o></o>
Replacewhat:=strReplaceText, _<o></o>
WholeWords:=True)<o></o>
<o></o>
Do While Not oTmpRng Is Nothing<o></o>
<o></o>
Set oTxtRng = oTxtRng.Characters _<o></o>
(oTmpRng.Start + oTmpRng.Length, oTxtRng.Length)<o></o>
Set oTmpRng = oTxtRng.Replace( _<o></o>
FindWhat:=strWhatReplace, _<o></o>
Replacewhat:=strReplaceText, _<o></o>
WholeWords:=True)<o></o>
Loop<o></o>
Next oShp<o></o>
Next activeSlide<o></o>

 

[pirespt]

Anyone?

Thanks

David

 

[sdeterman]

I too am stuck on the exact same thing. The weird part is that it worked fine in PowerPoint but when I transfered the code to Excel, made my tweaks it stopped.

I can see all of the "Shapes" in the active slide. Why the mismatch?

 

[pirespt]

I have come up with a work around.

A macro in Powerpoint that requires an inputbox with the data I want to replace with.

Then I run that from excel, not perfect though.

 

[sdeterman]

I keep thinking it has something to do with the fact that the Slide I and looping through isn't activated????