2016-10-02 3 views
0

VBA Я пытаюсь скопировать 1-й слайд из PowerPoint и вставить ее в конце, но я получаю ActiveX не может создать объект на линииActiveX не может создать объект powerpont

ActivePresentation.Slides(1).Copy 

Это мой полный код и я добавил ссылку на майкрософт библиотеку Powerpoint, а

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

Вы используете этот код из PowerPoint или Excel? –

+0

из Excel, поэтому я добавляю ссылку на библиотеку – newguy

ответ

1

Попробуйте отредактированный код ниже, я ppApp As PowerPoint.Application и 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 
+0

Еще раз спасибо .. – newguy

Смежные вопросы