Home/ Questions/Q 7522
Next
In Process
Computing Staff
  • 3
Asked: 2021-11-24T10:04:52+00:00 In:

PowerPoint VBA Select Slide

  • 3

My goal is to create 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 “ActiveX component can’t create object” error 429.

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 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 mySlide Is Nothing Then Set mySlide = 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")
 
set mySlide = 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

Share

    1 Answer

    1. Try this

      Sub CreatePowerPoint()
 
Dim mySlide As Object
Dim SelectedSlide As Object
Dim myShapeRange As PowerPoint.Shape
Dim oPA As Object
Dim oPP As PowerPoint.Presentation
Dim strTemplate As String
Dim rng As Range
 
strTemplate = "C:\Users\290866\Desktop\vba\PPT\Template.potx"
'
Set oPA = CreateObject("Powerpoint.application")
oPA.Visible = True
oPA.Presentations.Open strTemplate ', untitled:=msoTrue


'If Not mySlide Is Nothing Then Set mySlide = 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 = oPA.ActivePresentation.Slides(1)

 rng.Copy
    mySlide.Shapes.PasteSpecial (ppPasteBitmap)
  
  Set myShapeRange = mySlide.Shapes(mySlide.Shapes.Count)

myShapeRange.LockAspectRatio = False
      myShapeRange.Left = 20
      myShapeRange.Top = 80
      myShapeRange.Height = 400
 myShapeRange.Width = 680
  Application.CutCopyMode = False
 
 
End Sub

      • 0