Pic in Zelle einfügen und wieder löschen

Sub pic_einsetzen()
Dim PicPath As String, Pic As Picture, ImageCell As Range
PicPath = "F:\Pics\pic_einsetzen.png"
Set ImageCell = ActiveCell.MergeArea
Set Pic = ActiveSheet.Pictures.Insert(PicPath)
With Pic
.ShapeRange.LockAspectRatio = msoFalse
.Left = ImageCell.Left
.Top = ImageCell.Top
.Width = 45#
.Height = 23#
End With
End Sub

Sub pic_löschen()
Dim Pic As Picture
For Each Pic In ActiveZell.Pictures
Pic.Select
Pic.Cut
Next Pic
End Sub