PPT mit VBA Folienlayout

Sub Schaltfläche6_Klicken()
Dim oPPTApp As Object 'Die PowerPoint Anwendung
Dim oPPTFile As Object 'Die PowerPoint Datei
Dim oPPTSlide As Object 'PowerPoint Folien
'PowerPoint öffnen/starten
Set oPPTApp = CreateObject("Powerpoint.Application")
oPPTApp.Visible = True
'Neue Präsentation
Set oPPTFile = oPPTApp.Presentations.Add
'neue Folien einfügen
'Index: Foliennummer, Layout 12: Leeres Layout
Set oPPTSlide1 = oPPTFile.Slides.Add(Index:=1, Layout:=12)
Set oPPTSlide2 = oPPTFile.Slides.Add(Index:=2, Layout:=12)
Set oPPTSlide3 = oPPTFile.Slides.Add(Index:=3, Layout:=12)
Set oPPTSlide4 = oPPTFile.Slides.Add(Index:=4, Layout:=12)
'Anzeige auf 16:9 umstellen
oPPTApp.ActivePresentation.PageSetup.SlideSize = 15
'Kopiere Bereich und füge es in Folie ein
Tabelle7.Range("A1:N23").CopyPicture
oPPTSlide1.Shapes.Paste
With oPPTSlide1.Shapes(1)
.IncrementLeft 400
.IncrementTop 201
.Width = 721
End With
'Kopiere Bereich und füge es in Folie ein
'Tabelle1.Range("A4:I22").CopyPicture
'Changes because of new rows
Tabelle1.Range("A4:I24").CopyPicture
oPPTSlide2.Shapes.Paste
With oPPTSlide2.Shapes(1)
.IncrementLeft 397
.IncrementTop 195
.Width = 721
End With
'Kopiere Bereich und füge es in Folie ein
Tabelle3.Range("A1:G19").CopyPicture
oPPTSlide3.Shapes.Paste
With oPPTSlide3.Shapes(1)
.IncrementLeft 400
.IncrementTop 201
.Width = 721
End With
'Kopiere Bereich und füge es in Folie ein
'Tabelle2.Range("A7:C41").CopyPicture
'Changes because of new column
Tabelle2.Range("A7:C41").CopyPicture
oPPTSlide4.Shapes.Paste
With oPPTSlide4.Shapes(1)
.IncrementLeft 180
.IncrementTop 190
.Height = 360
End With
'Variablen leeren
Set oPPTSlide1 = Nothing
Set oPPTSlide2 = Nothing
Set oPPTSlide3 = Nothing
Set oPPTSlide4 = Nothing
Set oPPTSlide5 = Nothing
Set oPPTFile = Nothing
Set oPPTApp = Nothing
End Sub