AW: Bilder in Kommentaren zur Zeile ausrichten?
25.04.2016 22:53:39
Jürgen
hallo Firmus!
das ging jetzt ratzfatz bei dir!! Vielen Dank!
Der Code ist genial!!!!! Super...wenn per Click alles erledigt wird, was zuvor so umständlich war, toll!
Ich habe es so gelöst, dass ein Button das Makro ausführt. DEr Code zum einfügen der URL als Text sowie das Bildchen in den Kommentar schaut so aus:
Sub Bildvorschau()
' - einfügen von Hyperlink zur gewählten JPG-Datei
' - einfügen JPG-Datei als Vorschau im Kommentar
Dim wks As Worksheet
Dim rng As Range
Dim strFile As String
Dim dblWdth As Double
Dim dblHhgt As Double
Dim cmt As Comment
Dim sh As Shape
Set wks = ActiveSheet
Set rng = wks.Cells(wks.Rows.Count, 1).End(xlUp).Offset(, 6)
rng.ClearComments
rng.Value = ""
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = False
.InitialFileName = "c:\tmp\"
.Filters.Add "Bilder", "*.jpg"
.FilterIndex = .Filters.Count
If .Show = -1 Then
strFile = .SelectedItems(1)
Call GetJpgSize(strFile, dblWdth, dblHhgt)
wks.Hyperlinks.Add Anchor:=rng, Address:=strFile
Set cmt = rng.AddComment
Set sh = cmt.Shape
sh.Fill.UserPicture strFile
sh.Height = 80
sh.Width = sh.Height * dblWdth / dblHhgt
End If
End With
Set sh = Nothing
Set cmt = Nothing
Set rng = Nothing
Set wks = Nothing
End Sub
Function GetJpgSize(ByVal strFile As String, dblWdth As Double, dblHght As Double) As Boolean
' in Anlehnung an 'http://www.michael-schwimmer.de/vba061.htm
Dim intFF As Integer, c As Long, lngPntr As Long
Dim x As Byte, y As Byte, bytFlag As Byte
intFF = FreeFile
lngPntr = 1
Open strFile For Binary Access Read As #intFF
Get #intFF, 2, bytFlag
Get #intFF, 5, x
Get #intFF, 6, y
c = CDbl(x) * 256 + CDbl(y)
lngPntr = 6
Do
If (bytFlag = &HC2) Or (bytFlag = &HC0) Then
Get #intFF, lngPntr + 4, x
Get #intFF, , y
dblWdth = CDbl(x) * 256 + CDbl(y)
Get #intFF, lngPntr + 2, x
Get #intFF, , y
dblHght = CDbl(x) * 256 + CDbl(y)
GetJpgSize = True
Exit Do
End If
lngPntr = lngPntr + c - 2
Get #intFF, lngPntr + 1, x
If x 255 Then Exit Do
Get #intFF, , bytFlag
lngPntr = lngPntr + 2
Get #intFF, lngPntr + 1, x
Get #intFF, , y
c = CLng(x) * 256 + CLng(y)
lngPntr = lngPntr + 2
Loop While bytFlag &HD9
Close #intFF
End Function
Das integrieren innerhalb dieses Code gelang mir nicht, was aber nicht tragisch ist. manuell per Button hat auch seinen Vorteil, da vorab eine schlanke Liste sichtbar ist und erst bei Bedarf (z.B. bei Druck) die Bilder der Kommentare angeordnet werden.
Was allerdings hilfreich wäre (wenn ich schon so einen Profi an der Strippe habe), könnte man einen 2. Button generieren, welcher genau das umgegekehrte macht: also die Kommentare wieder ausblendet und die Zeilenhöhe wieder auf Standard zurück? Dann könnte man wie mit einem Lichtschalter Ein/Aus Blenden. Aber wie gesagt, dein Code ist schon der Oberhammer. Ich hätte nicht gedacht, dass das umzusetzen gelingt. Bin baff...
Danke & Gruss,
Juergen