Prüfung Zwischenspeicher

Sub screenshot()
Dim myChartObject As ChartObject, myShape As Shape
Dim bolfound As Boolean
Application.ScreenUpdating = False
Worksheets.Add
Zeile1:     ActiveSheet.Paste
For Each myShape In ActiveSheet.Shapes
If myShape.Type = msoPicture Then bolfound = True: Exit For
Next
If bolfound Then
myShape.CopyPicture Appearance:=2, Format:=-4147
Set myChartObject = ActiveSheet.ChartObjects.Add(0, 0, myShape.Width, myShape.Height)
With myChartObject
.Activate
.Chart.Paste
.Chart.Export Filename:=ActiveWorkbook.Path & "\" & Bereich & "\" & lastID & "\" & " _
Screenshot.jpg", FilterName:="JPG", Interactive:=False
End With
Set myChartObject = Nothing
Set myShape = Nothing
End If
With Application
.DisplayAlerts = False
ActiveSheet.Delete
.DisplayAlerts = True
.ScreenUpdating = True
End With
End Sub