Kommentargröße an Bild in Kommentar anpassen

Sub bildInKommentar() Dim vardatei As Variant Dim tDir As String ' a = 300 tDir = "C:\Users\csperber\Desktop" vardatei = Application.GetOpenFilename(FileFilter:="AlleDateien(*.jpg),*.*", _ Title:="Bitte einzubettende Datei auswählen") If vardatei False Then On Error Resume Next ActiveCell.Comment.Delete On Error GoTo 0 ActiveCell.AddComment ActiveCell.Comment.Visible = False ActiveCell.Comment.Text Text:="" ActiveCell.Comment.Shape.Fill.UserPicture vardatei b = ActiveCell.Comment.Shape.Width / ActiveCell.Comment.Shape.Height ActiveCell.Comment.Shape.Width = 300 ActiveCell.Comment.Shape.Height = 300 / b End If End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hi Oberschlumpf,
Nein, hab ich nicht.
Aber ich habe in der Zwischenzeit meine Denkensweise umgestellt, und einen passenden Code zusammenstoppeln können.
Also, falls das jemand benötigt, hier mein VBA Code, der einwandfrei funktioniert:

Public Sub Datei_Auswahl_Kommentar()
Dim strDatei As Variant
Dim strDummy As String
Dim ff As Integer
Dim c As Integer
Dim S As String
Dim L As Long
Dim JPGWidth As Long
Dim JPGHeight As Long
Dim a As Integer
'Basis für dieses Tool brachte der Link
'http://www.office-loesung.de/ftopic89707_0_0_asc.php
' Adaptiert für Kommentar einfügen von CSP - 30-06-2018
'Datei auswählen
With Application.FileDialog(msoFileDialogFilePicker)
.InitialFileName = "C:\"
.Title = "Dateiauswahl"
.ButtonName = "Auswahl..."
.Filters.Add "JPG-Dateien", "*.jpg; *.jpeg", 1
.InitialView = msoFileDialogViewList
If .Show = -1 Then
strDatei = .SelectedItems(1)
Else
MsgBox "Es wurde keine Datei ausgewaehlt!"
Exit Sub
End If
End With
ff = FreeFile()
Open strDatei For Binary Access Read As #ff
If Input(2, #ff)  (Chr$(&HFF) & Chr$(&HD8)) Then
Close #ff
Exit Sub
End If
strDummy = Input(2, #ff)
Do
L = Asc(Input(1, #ff))
L = L * 256 + Asc(Input(1, #ff))
S = Input(L - 2, #ff)
If c = &HC0 Or c = &HC2 Then
JPGWidth = Asc(Mid$(S, 4, 1))
JPGWidth = JPGWidth * 256 + Asc(Mid$(S, 5, 1))
JPGHeight = Asc(Mid$(S, 2, 1))
JPGHeight = JPGHeight * 256 + Asc(Mid$(S, 3, 1))
End If
If Input(1, #ff)  Chr$(255) Then
Exit Do
End If
c = Asc(Input(1, #ff))
Loop While c  &HD9
Close #ff
'MsgBox "Die Grafik " & strDatei & " ist " & vbNewLine & _
'CStr(JPGWidth) & " Pixel breit und " & vbNewLine & _
'CStr(JPGHeight) & " Pixel hoch.", _
'vbInformation, "JPG-Analyse"
'Kommentar einfügen
If strDatei  False Then
On Error Resume Next
ActiveCell.Comment.Delete
On Error GoTo 0
ActiveCell.AddComment
ActiveCell.Comment.Visible = False
ActiveCell.Comment.Text Text:=""
ActiveCell.Comment.Shape.Fill.UserPicture strDatei
'Kommentargröße definieren
a = 220                     'Variable für Basisgröße Kommentar
b = JPGWidth / JPGHeight    'Bildverhältnis berechnen
If JPGWidth > JPGHeight Then
ActiveCell.Comment.Shape.Width = a
ActiveCell.Comment.Shape.Height = a / b
Else
ActiveCell.Comment.Shape.Height = a
ActiveCell.Comment.Shape.Width = a * b
End If
End If
End Sub

Sg
Christian

Beliebteste Forumthreads (12 Monate)

Kommentargröße an Bild in Kommentar anpassen

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

304 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Kommentargröße an Bild in Kommentar anpassen

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

304 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread