2016-07-13 8 views
1

Ich möchte mehrere PPT-Datei mit VBA-Makro erstellen.Erstellen Sie mehrere PPT von Excel mit VBA

Betrachten Sie diesen Fall, bereits PPT-Anwendung wurde geöffnet. Wenn ich das Makro ausführen, sollte es eine neue separate PPT-Anwendung erstellen, aber mein Makro anfügen Folien auf geöffnete Datei.

Wie erstellt man eine separate PPT-Anwendung und macht den Rest der Dinge.

Danke, Unten ist ein Teil des Codes.

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 

Antwort

1

Sie wollen keine neue PPT-Anwendung erstellen, was Sie brauchen, ist eine neue PPT Präsentation und anschließend Folien hinzufügen, dass. Der einfachste Weg ist es, eine Variable für die Präsentation hinzufügen (dh Dim PPPres As Powerpoint.Presentation) und fügen Sie dann die neuen Folien dieser Präsentation

Edit: Einschließlich einer Version des Codes, die ich für die Initialisierung PPT-Präsentationen verwenden:

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 
+0

Sie sollte auch die Fehlerbehandlungsroutine nach dem Objekt zurücksetzen (und stattdessen einen get-Objektaufruf verwenden) – RGA

+0

Danke, dass es funktioniert – Singaravelan