使用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