G
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
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