使用vba從excel創建多個PPT

Question

我想使用vba宏創建多個PPT文件。

考慮這種情況，已經打開PPT應用程序。 當我運行宏時，它應該創建一個新的單獨的PPT應用程序，但是，我的宏在打開的文件上追加了幻燈片。

如何創建一個單獨的PPT應用程序，並做其餘的事情。

謝謝， 下面是代碼的一部分。

Dim newPowerPoint As Object 'PowerPoint.Application ' 
Dim activeSlide As Object 'PowerPoint.Slide 
Dim sht As Worksheet 


On Error Resume Next 
Set newPowerPoint = CreateObject("PowerPoint.Application") 
'If newPowerPoint Is Nothing Then 
      'Set newPowerPoint = New PowerPoint.Application 
'End If 

If newPowerPoint.Presentations.Count = 0 Then 
      newPowerPoint.Presentations.Add 
End If 

    'Show the PowerPoint 
newPowerPoint.Visible = True 

For Each sht In ActiveWorkbook.Sheets 



      newPowerPoint.ActivePresentation.Slides.Add newPowerPoint.ActivePresentation.Slides.Count + 1, ppLayoutText 
      newPowerPoint.ActiveWindow.View.GotoSlide newPowerPoint.ActivePresentation.Slides.Count 
      Set activeSlide = newPowerPoint.ActivePresentation.Slides(newPowerPoint.ActivePresentation.Slides.Count) 


    activeSlide.Shapes(1).Delete 
    activeSlide.Shapes(1).Delete 
    Range("A1:T32").Select 
    Selection.Copy 

    activeSlide.Shapes.PasteSpecial(DataType:=ppPasteEnhancedMetafile).Select 

Answer 1

你不想創建一個新的PPT應用程序，你需要的是一個新的PPT演示文稿，然後添加幻燈片。最簡單的辦法是增加一個變量的呈現（即Dim PPPres As Powerpoint.Presentation），然後添加新的幻燈片到演示

編輯：包括版本，我使用的初始化PPT演示代碼：

Dim PPApp As PowerPoint.Application 
Dim PPPres As PowerPoint.Presentation 
Dim PPSlide As PowerPoint.Slide 

'Open PPT if not running, otherwise select active instance 
On Error Resume Next 
Set PPApp = GetObject(, "PowerPoint.Application") 
If PPApp Is Nothing Then 
    'Open PowerPoint 
    Set PPApp = CreateObject("PowerPoint.Application") 
    PPApp.Visible = True 
End If 
On Error GoTo ErrHandler 

'Generate new Presentation and slide for graphic creation 
Set PPPres = PPApp.Presentations.Add 
Set PPSlide = PPPres.Slides.Add(1, ppLayoutBlank) 
PPApp.ActiveWindow.ViewType = ppViewSlide 
PPPres.PageSetup.SlideSize = ppSlideSizeOnScreen 
PPApp.ActiveWindow.WindowState = ppWindowMaximized