Office: Bild in Kommentar

Torsten1 · 7. April 2013

Hallo

Ich würde gerne dem Benutzer die Möglichkeit geben,
in eine beliebige (gewählte) Zelle (Zellbereich A6:B25) als Kommentar, ein Bild einzufügen,
wenn in Zelle F33 "ein" steht.

Ich kann ja in jede beliebige Zelle einen Kommentar einfügen.
Dann klicke ich mit der rechten Maustaste auf den Rand des Kommentars,
gehe auf Kommentar formatieren > Farben und Linien > Fülleffekte > Grafik > Grafik auswählen.

Nun würde ich gerne:
1. wenn in Zelle F33 "ein" steht und der Benutzer eine Zelle (im Zellbereich A6:B25) anwählt,
dass er gleich zum auswählen der Grafik gelangt (Datei öffnen)
2. der Kommentar mit der Grafik bzw. die Grafik als Kommentarfeld angelegt wird.

Ich weiß noch nicht einmal, wie ich einen Kommentar per VBA einfügen kann,
geschweige denn noch ein Bild dazu.

Idee ?

Nette Grüße
Torsten

:)

HolN · 9. April 2013

Hallo Torsten,

versuche doch mal die Aktion aufzuzeichnen.

Danach kannst den Code ja deinen Bedürfnissen anpassen

Gruß
Holger

Torsten1 · 9. April 2013

Habe ich schon - hat aber nichts gebracht.
Das war das Ergebnis:
Code:

Range("B23").Select
Range("B23").AddComment
Range("B23").Comment.Visible = False
Selection.ShapeRange.ScaleHeight 1.66, msoFalse, msoScaleFromTopLeft
Range("F31").Select
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Habe aber folgendes gefunden, was auch sehr gut funktioniert:
Code:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
ChDrive "D:\"
ChDir "D:\"
dateiname = Application.GetOpenFilename("Microsoft Excel-Dateien (*.jpg),*.jpg")
If dateiname = False Then Exit Sub
With Target
.AddComment
.Comment.Shape.Fill.UserPicture dateiname
.Comment.Shape.Height = 60
.Comment.Shape.Width = 100
End With
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Das funktioniert mit Doppelklick recht gut.

Was mir noch fehlt:
1. die Beschränkung auf A6:B25 (F33 braucht es nicht mehr)
2. wenn möglich eine automatische Größenanpassung
so in etwa "Seitenverhältnis beibehalten, jedoch nicht breiter als bspw. Width = 100
3. wenn möglich noch die Dateiformate: *.png, *.BMP, *.Gif

Nette Grüße
Torsten

Zai-Ba · 9. April 2013

Schau dir mal den alten Beitrag von Jinx an:
link (2. Snippet)

Torsten1 · 9. April 2013

Hmm - da konnte ich für mich irgendwie nichts verwertbares herauslesen.

Das blöde Seitenverhältnis will nich......
Code:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim dblHoehe As Double
Dim booEintrag As Boolean
If Not ActiveCell.Comment Is Nothing Then
If MsgBox("Es ist bereits ein Kommmentar in dieser Zelle enthalten. Diesen ersetzen?", _
vbYesNo) = vbYes Then
ActiveCell.Comment.Delete
booEintrag = True
End If
Else
booEintrag = True
End If
If booEintrag Then
ChDrive "D:\"
ChDir "D:\"
dateiname = Application.GetOpenFilename("Microsoft Excel-Dateien (*.jpg),*.jpg")
If dateiname = False Then Exit Sub Else
With ActiveCell
.AddComment
.Comment.Visible = False
.Comment.Shape.Fill.UserPicture dateiname
dblHoehe = .Comment.Shape.Height / .Comment.Shape.Width '
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Torsten1 · 9. April 2013

Habe soweit alles hinbekommen (auch mit den Dateinamen).

Noch jemand eine Idee zum Seitenverhältnis ?

Nette Grüße
Torsten

Torsten1 · 9. April 2013

Hallo

Ich habe folgenden Code von "Beverly" gefunden:
Code:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim picBild As Picture
Dim booEintrag As Boolean
If Not ActiveCell.Comment Is Nothing Then
If MsgBox("Es ist bereits ein Kommmentar in dieser Zelle enthalten. Diesen ersetzen?", _
vbYesNo) = vbYes Then
ActiveCell.Comment.Delete
booEintrag = True
End If
Else
booEintrag = True
End If
If booEintrag Then
Application.ScreenUpdating = False
Set picBild = ActiveSheet.Pictures.Insert("C:\Dokumente und Einstellungen\" & _
Environ("Username") & "\Eigene Dateien\Eigene Bilder\Unbenannt.jpg")
With ActiveCell
.AddComment
.Comment.Visible = False
.Comment.Shape.Width = picBild.Width
.Comment.Shape.Height = picBild.Height
.Comment.Text Text:=Environ("Username") & ":" & Chr(10) & ""
.Comment.Shape.Fill.UserPicture "C:\Dokumente und Einstellungen\" & _
Environ("Username") & "\Eigene Dateien\Eigene Bilder\Unbenannt.jpg"
.Comment.Shape.LockAspectRatio = msoTrue
End With
picBild.Delete
Set picBild = Nothing
Application.ScreenUpdating = True
End If
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Wie muß der Code abgeändert werden, wenn der Benutzer selber eine Datei
auswählen darf (Application.GetOpenFilename - also keine vorgegebene Datei) ?

Nette Grüße
Torsten

Torsten1 · 9. April 2013

So - das habe ich auch hinbekommen !

Nur öffnet sich der "Datei-öffnen-Dialog" zweimal........
Code:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim dblHoehe As Double
Dim picBild As Picture
Dim booEintrag As Boolean
If Not ActiveCell.Comment Is Nothing Then
If MsgBox("Es ist bereits ein Kommmentar in dieser Zelle enthalten. Diesen ersetzen?", _
vbYesNo) = vbYes Then
ActiveCell.Comment.Delete
booEintrag = True
End If
Else
booEintrag = True
End If
If booEintrag Then
ChDrive "D:\"
ChDir "D:\"
dateiname = Application.GetOpenFilename("Microsoft Excel-Dateien (*.jpg;*.png;*.bmp;*.gif),*.jpg;*.png;*.bmp;*.gif")
If dateiname = False Then Exit Sub Else
Application.ScreenUpdating = False
Set picBild = ActiveSheet.Pictures.Insert(Application.GetOpenFilename("Microsoft Excel-Dateien (*.jpg;*.png;*.bmp;*.gif),*.jpg;*.png;*.bmp;*.gif"))
With ActiveCell
.AddComment
.Comment.Visible = False
.Comment.Shape.Width = picBild.Width
.Comment.Shape.Height = picBild.Height
'.Comment.Text Text:=Environ("Username") & ":" & Chr(10) & ""
.Comment.Shape.Fill.UserPicture dateiname '"C:\Dokumente und Einstellungen\" & _
'Environ("Username") & "\Eigene Dateien\Eigene Bilder\Unbenannt.jpg"
.Comment.Shape.LockAspectRatio = msoTrue
End With
picBild.Delete
Set picBild = Nothing
With ActiveCell
dblHoehe = .Comment.Shape.Height / .Comment.Shape.Width '
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Zai-Ba · 9. April 2013

Die Dialoge werden mit den beiden rot markierten Zeilen aufgerufen.

Entweder du schmeißt die erste raus,

oder du ersetzt den Application.GetOpenFilename-Kram durch deine dateiname-Variable.

Da du den Check drin hast, ob eine Datei gewählt wurde, würde ich an deiner Stelle zweiteres versuchen.
Code:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim blablubb

ChDrive "D:\"
ChDir "D:\"
dateiname = Application.GetOpenFilename("Microsoft Excel-Dateien (*.jpg;*.png;*.bmp;*.gif),*.jpg;*.png;*.bmp;*.gif")
If dateiname = False Then Exit Sub Else
Application.ScreenUpdating = False
Set picBild = ActiveSheet.Pictures.Insert(Application.GetOpenFilename("Microsoft Excel-Dateien (*.jpg;*.png;*.bmp;*.gif),*.jpg;*.png;*.bmp;*.gif"))
With ActiveCell
.AddComment
blablubb
End With
blablubb

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Torsten1 · 9. April 2013

Danke für die Antwort !

Ich hatte mir schon gedacht, dass es am "insert" liegt.
Allerdings weiß ich nicht, wie die "Dateiname-Variable" aussehen soll !?

Help !!!!

Nette Grüße
Torsten

Torsten1 · 9. April 2013

So - habe es hinbekommen.

Für die "Nachwelt":
Code:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim dblHoehe As Double
Dim picBild As Picture
Dim booEintrag As Boolean
If Not ActiveCell.Comment Is Nothing Then
If MsgBox("Es ist bereits ein Kommmentar in dieser Zelle enthalten. Diesen ersetzen?", _
vbYesNo) = vbYes Then
ActiveCell.Comment.Delete
booEintrag = True
End If
Else
booEintrag = True
End If
If booEintrag Then
ChDrive "D:\"
ChDir "D:\"
dateiname = Application.GetOpenFilename("Microsoft Excel-Dateien (*.jpg;*.png;*.bmp;*.gif),*.jpg;*.png;*.bmp;*.gif")
If dateiname = False Then Exit Sub Else
Application.ScreenUpdating = False
Set picBild = ActiveSheet.Pictures.Insert([dateiname])
With ActiveCell
.AddComment
.Comment.Visible = False
.Comment.Shape.Width = picBild.Width
.Comment.Shape.Height = picBild.Height
.Comment.Shape.Fill.UserPicture dateiname
.Comment.Shape.LockAspectRatio = msoTrue
End With
picBild.Delete
Set picBild = Nothing
With ActiveCell
dblHoehe = .Comment.Shape.Height / .Comment.Shape.Width '
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Torsten1 · 10. April 2013

Damit es keinen Absturz gibt, wenn keine Datei/kein Bild ausgewählt wird (was bei mir passiert ist) also "Öffnen-Dialog" auf "Abbruch":
Code:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim dblHoehe As Double
Dim picBild As Picture
Dim booEintrag As Boolean
ActiveSheet.Unprotect
If Not ActiveCell.Comment Is Nothing Then
If MsgBox("Es ist bereits ein Kommmentar in dieser Zelle enthalten. Diesen ersetzen?", _
vbYesNo) = vbYes Then
ActiveCell.Comment.Delete
booEintrag = True
End If
Else
booEintrag = True
End If
If booEintrag Then
ChDrive "D:\"
ChDir "D:\"
dateiname = Application.GetOpenFilename("Microsoft Excel-Dateien (*.jpg;*.png;*.bmp;*.gif),*.jpg;*.png;*.bmp;*.gif")
If dateiname = False Then GoTo Ende Else
Application.ScreenUpdating = False
Set picBild = ActiveSheet.Pictures.Insert([dateiname])
With ActiveCell
.AddComment
.Comment.Visible = False
.Comment.Shape.Width = picBild.Width
.Comment.Shape.Height = picBild.Height
.Comment.Shape.Fill.UserPicture dateiname
.Comment.Shape.LockAspectRatio = msoTrue
End With
picBild.Delete
Set picBild = Nothing
With ActiveCell
dblHoehe = .Comment.Shape.Height / .Comment.Shape.Width '
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Office: Bild in Kommentar

Bild in Kommentar

Bild in Kommentar

Bild in Kommentar

Bild in Kommentar

Bild in Kommentar - Similar Threads - Bild Kommentar

Feste Verankerung eines Bildes in Kopfzeile lösen

Bilder über VBA Größe und DPI ändern für Webshop

Seitenzahlen sind komplett verschoben....

Bilder lassen sich nicht verschieben

VBA Summe bilden

Excel Range als Bild in Word einfügen

Bild in Kommentar einbauen?