Moin Zusammen,

ich möchte gerne Bilder mit einem Klick als Notiz in eine Zelle einfügen. Ich habe 3 Module, welche ich unten einfügen werde. Mit einer JPG Datei funktioniert es wie ich es möchte, nur nicht mit einer PNG Datei. Kann mir da jemand weiterhelfen?

Modul 1:
 

Sub BildHinzufuegen()
Dim strFilename As Variant
Dim strFilter As String
Dim strText As String
Dim rngDest As Range

'Ziel des Kommentars festlegen
Set rngDest = ActiveCell

'Dateiauswahl filtern
strFilter = "JPG Files (*.jpg), *.jpg" _
& ", PNG Files (*.png), *.png" _
& ", GIF Files (*.gif), *.gif" _
& ", Bitmaps (*.bmp), *.bmp" _
& ", WMF Files (*.wmf), *.wmf"

'Dialog Dateiauswahl
strFilename = Application.GetOpenFilename(strFilter)

'Brich ab, wenn nichts gewählt
If strFilename = False Then Exit Sub

'Kommentartext abfragen
strText = InputBox("Bitte Kommentar eingeben", "Kommentar")

'Funktion aufrufen
AddPictureAsComment rngDest, CStr(strFilename), _
strText, 200

'Kommentare ausgeblendet
Application.DisplayCommentIndicator = xlCommentIndicatorOnly

End Sub

Modul 2:

Public Sub AddPictureAsComment(Dest As Range, _
Source As String, Optional strComment As String, _
Optional PicHeight As Double = 0)

Dim objPic As IPictureDisp
Dim objComment As Comment
Dim dblScale As Double

On Error Resume Next

'Bild wegen Abfrage der Größe laden
Set objPic = LoadPicture(Source)

'Brich ab, wenn kein Bild
If objPic Is Nothing Then Exit Sub

'Kommentar in Zielzelle löschen
Dest.ClearComments

'Kommentar in Zielzelle hinzufügen
Set objComment = Dest.AddComment

'Skalierung berechnen
If PicHeight > 0 Then
dblScale = PicHeight / (objPic.Height * 72 / 2540)
Else
dblScale = 1
End If

'Kommentar mit Bildhintergrund und Text füllen
With objComment
 .Shape.Fill.UserPicture Source
 .Shape.Height = (objPic.Height * 72 / 2540) * dblScale
 .Shape.Width = (objPic.Width * 72 / 2540) * dblScale
 .Text Text:=strComment
End With
End Sub

Modul 3:

Private Sub CommandButton1_Click()
BildHinzufuegen
End Sub