PowerPoint VBA select slide - vba

Question

My goal is to creat ppt via VBA. I have already the template in my desktop that i need to use. This part of the code is ok.
However I did not find how to select slides in the ppt. I try many ways and i get all the times error.
If someone could help me.
Option Explicit
Sub CreatePowerPoint()
Dim mySlide As PowerPoint.Slide
Dim myShapeRange As PowerPoint.Shape
Dim oPA As PowerPoint.Application
Dim oPP As PowerPoint.Presentation
Dim oPS As PowerPoint.SlideRange
Dim strTemplate As String
Dim rng As Range
strTemplate = "C:\Users\290866\Desktop\vba\PPT\Template.potx"
Set oPA = New PowerPoint.Application
oPA.Visible = msoTrue
oPA.Presentations.Open strTemplate, untitled:=msoTrue
If Not oPS Is Nothing Then Set oPS = Nothing
If Not oPP Is Nothing Then Set oPP = Nothing
If Not oPA Is Nothing Then Set oPA = Nothing
Err_PPT:
If Err <> 0 Then
MsgBox Err.Description
Err.Clear
Resume Next
End If
Set rng = ThisWorkbook.Sheets("Credit Recommendation").Range("B2:N59")
ActivePresentation.Slides (1)
rng.Copy
mySlide.Shapes.PasteSpecial (ppPasteBitmap)
Set myShapeRange = mySlide.Shapes(mySlide.Shapes.Count)
myShapeRange.LockAspectRatio = msoFalse
myShapeRange.Left = 20
myShapeRange.Top = 80
myShapeRange.Height = 400
myShapeRange.Width = 680
Application.CutCopyMode = False
End Sub
Thank you!!!

Answer 1

Here is your code modified to work. I explain the modifications below
Option Explicit
Sub CreatePowerPoint()
Dim mySlide As PowerPoint.Slide
Dim myShapeRange As PowerPoint.Shape
Dim oPA As PowerPoint.Application
Dim oPP As PowerPoint.Presentation
Dim oPS As PowerPoint.SlideRange
Dim strTemplate As String
Dim rng As Range
strTemplate = "C:\Users\290866\Desktop\vba\PPT\Template.potx"
Set oPA = New PowerPoint.Application
oPA.Visible = msoTrue
'changed this line to assign the new presentation to your variable
Set oPP = oPA.Presentations.Open(strTemplate, untitled:=msoTrue)
'If Not oPS Is Nothing Then Set oPS = Nothing
'If Not oPP Is Nothing Then Set oPP = Nothing
'If Not oPA Is Nothing Then Set oPA = Nothing
Err_PPT:
If Err <> 0 Then
MsgBox Err.Description
Err.Clear
Resume Next
End If
Set rng = ThisWorkbook.Sheets("sheet1").Range("B2:N59")
Set mySlide = oPP.Slides(1)
rng.Copy
mySlide.Shapes.PasteSpecial (ppPasteBitmap)
Set myShapeRange = mySlide.Shapes(mySlide.Shapes.Count)
myShapeRange.LockAspectRatio = msoFalse
myShapeRange.Left = 20
myShapeRange.Top = 80
myShapeRange.Height = 400
myShapeRange.Width = 680
Application.CutCopyMode = False
End Sub
You were declaring variables and never setting them equal to anything. I still did not see where oPS was ever used.
You received the ActiveX error because PowerPoint did not have an active presentation. It is always safer to work with your own objects rather than ActiveAnything within Office. So I set oPP equal to your new presentation and then used oPP rather than ActivePresentation
Also you never need to set things equal to nothing unless you're being picky about the order it happens. Everything declared in the Sub is set to nothing at the end of the sub.
Hope this helps!
Edit: Search and Replace
This is where I got the code, but I modified it to work as a callable Sub because I was calling it from different places many times:
'Find and Replace function
Sub FindAndReplace(sFind As String, sReplace As String, ByRef ppPres As PowerPoint.Presentation)
Dim osld As PowerPoint.Slide
Dim oshp As PowerPoint.Shape
Dim otemp As PowerPoint.TextRange
Dim otext As PowerPoint.TextRange
Dim Inewstart As Integer
For Each osld In ppPres.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(sFind, sReplace, , msoFalse, msoFalse)
Do While Not otemp Is Nothing
Inewstart = otemp.Start + otemp.Length
Set otemp = otext.Replace(sFind, sReplace, Inewstart, msoFalse, msoFalse)
Loop
End If
End If
Next oshp
Next osld
End Sub
You'll have to pass it the 2 strings and the Presentation object. It'll look like this in your Sub
FindAndReplace("FindMe","ReplaceWithThis", oPP)