VBA: Excel-Export als Screenshot in PPT
18.10.2019 11:05:35
Victor
mit meinem aktuellen Code (siehe unten) wird ein Excel-Bereich automatisiert in eine PPT eingebettet.
Durch das Einbetten wird die PPT-Dateigröße sehr groß - daher würde ich das Ganze gerne als Screenshot einfügen.
Kennt ihr hierzu eine einfache Lösung ohne den gesamten Code neu aufzusetzen?
Vielen Dank im Voraus und freundliche Grüße
Set ppApp = CreateObject("Powerpoint.Application")
ppApp.Visible = msoTrue
Set PpDatei = ppApp.Presentations.Open(pfad & "Template.pptx", False, False, True)
Call Einbetten(rng:=wkb.Worksheets("Cockpit").Range("C36:AE39"), zahl:=2, z2:=1, pp:=ppApp)
Call Einbetten(rng:=wkb.Worksheets("Cockpit").Range("C10:H16"), zahl:=2, z2:=4, pp:=ppApp)
Call Einbetten(rng:=wkb.Worksheets("Cockpit").Range("C43:AE60"), zahl:=2, z2:=2, pp:=ppApp)
Call Einbetten(rng:=wkb.Worksheets("Cockpit").Range("C64:AE96"), zahl:=3, z2:=3, pp:=ppApp)
ppApp.ActivePresentation.Slides(1).Shapes("Rechteck 1").TextFrame.TextRange.Text = wkb.Worksheets("Hilfe").Range("A4").Value
numSlides = ppApp.ActivePresentation.Slides.Count
For intSlides = 2 To numSlides
ppApp.ActivePresentation.Slides(intSlides).Shapes("Fußzeilenplatzhalter 2").TextFrame.TextRange.Text = wkb.Worksheets("Hilfe").Range("A4").Value
Next intSlides
'Präsentation als neue Präsentation speichern
PpDatei.SaveAs pfad & name & "_" & num & ".pptx"
wkb.Worksheets("Hilfe").Range("B4").Value = num + 1
End Sub
Sub Einbetten(rng As Excel.Range, zahl As Integer, z2 As Integer, pp As Object)
Dim ppShape As Object
Dim ppSlide As Object
Dim num As Integer
rng.Copy
'Excelbereich als Grafik auf Folie einfügen
' pp.ActivePresentation.Slides(zahl).Shapes.PasteSpecial DataType:=2 '2=ppPasteEnhancedMetafile
'Excelbereich als Excel-Objekt ohne Verknüpfung auf Folie einfügen
pp.ActivePresentation.Slides(zahl).Shapes.PasteSpecial DataType:=10, Link:=msoFalse '10= ppPasteOLEObject
'eingefügtes Object - Shape-Objekt-Variable zuweisen
Set ppShape = pp.ActivePresentation.Slides(zahl).Shapes(pp.ActivePresentation.Slides(zahl).Shapes.Count)
'Eingefügtes Shape formatieren
If z2 = 1 Then
With ppShape
'Shape positionieren (zentrieren auf Folie)
'.Height = 78
.Width = 886
.Top = 112
.Left = pp.ActivePresentation.Slides(zahl).Parent.PageSetup.SlideWidth / 2 - ppShape.Width / 2
End With
End If