Thema Datum  Von Nutzer Rating
Antwort
Rot Bilder über Notizen einfügen
08.12.2022 10:16:36 MZT
NotSolved
08.12.2022 10:47:01 Gast27344
NotSolved
08.12.2022 10:51:31 Gast48447
NotSolved
08.12.2022 10:59:45 Gast46761
NotSolved
08.12.2022 11:18:19 Gast6913
NotSolved

Ansicht des Beitrags:
Von:
MZT
Datum:
08.12.2022 10:16:36
Views:
261
Rating: Antwort:
  Ja
Thema:
Bilder über Notizen einfügen

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


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:

 
 

  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
Rot Bilder über Notizen einfügen
08.12.2022 10:16:36 MZT
NotSolved
08.12.2022 10:47:01 Gast27344
NotSolved
08.12.2022 10:51:31 Gast48447
NotSolved
08.12.2022 10:59:45 Gast46761
NotSolved
08.12.2022 11:18:19 Gast6913
NotSolved