ActiveX cannot create powerpont vba object
I am trying to copy the 1st slide from PowerPoint and paste it at the end, but I get that ActiveX cannot create an object in line
ActivePresentation.Slides(1).Copy
This is my complete code and I added a link to the microsoft powerpoint library as well
Option Explicit
Dim myFile, Fileselected As String, Path As String, objPPT As Object
Dim activeSlide As PowerPoint.Slide
Sub Generate_PPTs()
Application.ScreenUpdating = False
Set myFile = Application.FileDialog(msoFileDialogOpen)
With myFile
.Title = "Choose Template PPT File."
.AllowMultiSelect = False
If .Show <> -1 Then
Exit Sub
End If
Fileselected = .SelectedItems(1)
End With
Path = Fileselected
Set objPPT = CreateObject("PowerPoint.Application")
Set objPPT = objPPT.Presentations.Open(Path)
Debug.Print objPPT.Name
ActivePresentation.Slides(1).Copy
ActivePresentation.Slides.Paste Index:=objPPT.Slides.Count + 1
Set activeSlide = objPPT.Slides(objPPT.Slides.Count)
Application.ScreenUpdating = True
Set objPPT = Nothing
End Sub
0
source to share
1 answer
Try to edit the code below, I have ppApp As PowerPoint.Application
and Dim ppPres As PowerPoint.Presentation
:
Option Explicit
Dim myFile, Fileselected As String, Path As String, objPPT As Object
Dim ppApp As PowerPoint.Application
Dim ppPres As PowerPoint.Presentation
Dim activeSlide As PowerPoint.Slide
Sub Generate_PPTs()
Application.ScreenUpdating = False
Set myFile = Application.FileDialog(msoFileDialogOpen)
With myFile
.Title = "Choose Template PPT File."
.AllowMultiSelect = False
If .Show <> -1 Then
Exit Sub
End If
Fileselected = .SelectedItems(1)
End With
Path = Fileselected
Dim i As Integer
Set ppApp = New PowerPoint.Application
i = 1
ppApp.Presentations.Open Filename:=Path ' 'PowerPointFile = "C:\Test.pptx"
Set ppPres = ppApp.Presentations.Item(i)
' for debug
Debug.Print ppPres.Name
ppPres.Slides(1).Copy
ppPres.Slides.Paste Index:=ppPres.Slides.Count + 1
Set activeSlide = ppPres.Slides(ppPres.Slides.Count)
Application.ScreenUpdating = True
Set ppPres = Nothing
Set ppApp = Nothing
End Sub
+2
source to share