Bild aus Zw-Ablage bleibt in UF weiß

Public Sub Image1_Click()
Public Sub Image1_Click()
Const FILE_PATH As String = "C:\Users\Harry\Desktop\Test.jpg"
Dim objShape As Shape, objChartObject As ChartObject
Dim objWorksheet As Worksheet
Application.ScreenUpdating = False
Set objWorksheet = ThisWorkbook.Worksheets.Add
With objWorksheet
Call .Paste
If .Shapes.Count = 1 Then
Set objShape = .Shapes(1)
Set objChartObject = .ChartObjects.Add(Left:=0, Top:=0, _
Width:=objShape.Width, Height:=objShape.Height)
With objChartObject
Call .Chart.Paste
Call .Chart.Export(Filename:=FILE_PATH, FilterName:="JPG")
Set Image1.Picture = LoadPicture(FILE_PATH, PictureSizeMode = fmPictureSizeModeZoom)
Me.Repaint
Call Kill(PathName:=FILE_PATH)
End With
Else
Call MsgBox("Kein Bild in der Zwischenablage.", vbExclamation, "Hinweis")
End If
End With
Application.DisplayAlerts = False
objWorksheet.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Set objWorksheet = Nothing
Set objShape = Nothing
Set objChartObject = Nothing
End Sub