wie kann ich diese Code anpassen, dass er keine neue Slide in PowerPoint einfügt, sondern er kopiert die Diagramme und fügt es in schon bestehenden Slide?
Falls jemand mir helfen würde, wäre dankbar!
Public Sub Sub_0815()
Dim objPP As Object 'PowerPoint.Application
Dim objP As Object 'PowerPoint.Presentation
Dim objCL As Object 'PowerPoint.CustomLayout
Dim objS As Object 'PowerPoint.Slide
Dim ShRg As Object 'PowerPoint.ShapeRange
Dim i%, PrRg$
Set objPP = CreateObject("PowerPoint.Application")
Set objP = objPP.Presentations.Open("C:\Users\Ro\OneDrive\Dokumente\Liste\Bearbeitung.pptx")
Set objCL = objP.SlideMaster.CustomLayouts(1)
For i = 3 To 1 Step -1
'Druckbereich des Excel-Blattes ermitteln
PrRg$ = Worksheets(i).PageSetup.PrintArea
If Len(PrRg$) Then
'Druckbereich in die Zwischenablage als Bild kopieren
Worksheets(i).Range(PrRg$).CopyPicture
'Den Slide-Objekten ein neues Slide-Objekt voranstellen;
'diesem das CustomLayout "objCL" zuweisen
Set objS = objP.Slides.AddSlide(1, objCL)
'Die Zwischenablage am Ende der Shape-Auflistung einf?gen
Set ShRg = objS.Shapes.Paste
'Das letzte (=eingef?gte) Shape-Objekt eventuell noch anpassen
With ShRg(ShRg.Count)
.Left = 100
.Top = 200
.BackgroundStyle = 9
End With
End If
Next i
objPP.Visible = True
End Sub