ActiveX can't create object powerpont vba

2019-09-09 21:13发布

I am trying to copy 1st slide from the powerpoint and insert it at the end but I am getting ActiveX can't create object on the line

ActivePresentation.Slides(1).Copy

This is my full code and I've added the reference to 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

1条回答
在下西门庆
2楼-- · 2019-09-09 22:12

Try edited 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
查看更多
登录 后发表回答