VBA PowerPoint

[Guest]

I am trying to adapt some code to PowerPoint but it has proven quite
difficult. I have turned on the PowerPoint Object Library (9.0) in references
and wrote the following code but get two errors.

Dim oPPApp As PowerPoint.Application
Dim oPPtrg As PowerPoint.Presentation

'Error handler
On Error GoTo ErrHandler

' Get a reference to PowerPoint app
Set oPPApp = New PowerPoint.Application

'Search .ppt files in the same folder
With oPPApp.FileSearch
.NewSearch
.Filename = "*.ppt"
.LookIn = ThisWorkbook.Path
.SearchSubFolders = False
.Execute
'Loop in found files

For i = 1 To .FoundFiles.Count

'Open presentation
Set oPPtrg = oPPApp.Presentations.Open(.FoundFiles(i), , , msoFalse)

'calls Sub ReplaceTextPP here and does other things

'errors here (improper property) and...
oPPtrg.Close True
oPPApp.Quit

'etc.

End Sub

'Then the next part looks like this

Private Sub ReplaceTextPP(ColumnA As String, ColumnB As String, oPPApp As
PowerPoint.Application)

Dim TotalSlides As Integer
TotalSlides = oPPApp.ActivePresentation.Slides.Count

For s = 1 To TotalSlides

'errors here (runtime error. application (undefined member): invalid
request. no active presentation)
With oPPApp.ActivePresentation.Slides(s)
For a = 1 To .Shapes.Count
With .Shapes(a)
If .HasTextFrame Then
If .TextFrame.HasText Then
On Error Resume Next
.TextFrame.TextRange.Replace FindWhat:=ColumnA,
Replacewhat:=ColumnB, MatchCase:=False, WholeWords:=False
End If
End If
End With
Next a
End With
Next s

End Sub

 

[Steve Rindsberg]

Hi Gregory,

Ya beat me here. I was just heading over to the other group to see if I could help with this.

OK. New version. Won't swear that it does the replaces but it opens the requested files and tries
its best. No errors here.

Sub Test()

Dim oPPApp As PowerPoint.Application
Dim oPPTrg As PowerPoint.Presentation

Dim i As Long

'Error handler
On Error GoTo errhandler

' Get a reference to PowerPoint app
Set oPPApp = New PowerPoint.Application

'Search .ppt files in the same folder
With oPPApp.FileSearch
.NewSearch

' WATCH THIS: I changed it to narrow down the selection of files
.Filename = "test*.ppt"

.LookIn = ThisWorkbook.Path
.SearchSubFolders = False
.Execute

' How many did we find? Make sure it's at least one.
Debug.Print .FoundFiles.Count

'Loop in found files
' I'd surround this with
' If .FoundFiles.Count > 0 Then ....

For i = 1 To .FoundFiles.Count
Debug.Print .FoundFiles(i)

'Open presentation
Set oPPTrg = oPPApp.Presentations.Open(.FoundFiles(i), , , msoFalse)
' I'm passing the current open PRESENTATION, not the APP
' and have modified your subroutine accordionly,
Call ReplaceTextPP("InnaGaddaDaVida", "Lady Of Spain", oPPTrg)

oPPTrg.Close ' Close doesn't take a parameter in PPT

Next
End With
' Hard to tell from your posted code, but you don't want to quit
' until after you're done processing files.
oPPApp.Quit

MsgBox "Done!"
'etc.
normalexit:
Exit Sub
errhandler:
MsgBox Err.Description & vbCrLf & Err.Number
Exit Sub
End Sub

'Then the next part looks like this

Private Sub ReplaceTextPP(ColumnA As String, ColumnB As String, _
oPPTrg As PowerPoint.Presentation)

Dim a As Long
Dim s As Long
Dim TotalSlides As Integer
TotalSlides = oPPTrg.Slides.Count

For s = 1 To TotalSlides
With oPPTrg.Slides(s)
For a = 1 To .Shapes.Count
With .Shapes(a)
If .HasTextFrame Then
If .TextFrame.HasText Then
On Error Resume Next
.TextFrame.TextRange.Replace FindWhat:=ColumnA, _
Replacewhat:=ColumnB, MatchCase:=False, _
WholeWords:=False
End If
End If
End With
Next a
End With
Next s

End Sub

 

[Guest]

Steve! You're back! I thought I lost you.

You're code runs great. Passing the open presentation was brilliant. I think
I'm slowly catching on to the PowerPoint concept.

Anyway, thanks so much again. You've been a fantastic help.

Greg

 

[Steve Rindsberg]

Steve! You're back! I thought I lost you.

I once was lost, but then they stopped looking for me.
Say "Amazing", Gracie.

(And if you understood that, you're scarier than I am) ;-)

You're code runs great. Passing the open presentation was brilliant. I think
I'm slowly catching on to the PowerPoint concept.

It takes a while to get used to this idea of tossing objects around, but it's quite amazing what you
can do with the idea once it takes hold.

 

[Glen Millar]

Steve! You're back! I thought I lost you.

I once was lost, but then they stopped looking for me.
Say "Amazing", Gracie.

(And if you understood that, you're scarier than I am) ;-)

Hmmm. Steve either just got out of bed, or should be back there for more
sleep ;-)

 

[Steve Rindsberg]

Hmmm. Steve either just got out of bed, or should be back there for more
sleep ;-)

Fonts. Windows.

Enough to send anyone around the bend ...