Zellgröße an Bilder anpassen

Hallo zusammen,
ich bekomme immer wieder Tabellen mit Bildinhalten.
Hier sind die Splaten und Zeilen kleiner als das Bild selber.Diese Bilder passe ich manuell an. Dh.
Das Bild wird über die "Ecken" proportional verkleintert... oder die Zeilen/ Splaten werden vergrößert!
...das Ganze macht viel arbeit!
Könnte man ein Makro dazu anfertigen welches folgende Randbedingungen hat:
Wenn das Makro Bilder in Zellen findert soll die max. Spaltenbreite 70 betragen.
Das Bild selber soll max. 60 betragen!
Die Spaltenhöhe passt sich dann an das Bild an.Das Bild darf soll sich nur Proportional veränder (verkleinert/ vergrößert).
Ist Text in der Zelle darf dieser nicht verdeckt werden.Texte werden ggf. nach oben links formatiert!
Jeder Zelle hat nur ein Bild, welches oben Links angeordnet ist und über den Zellbereich hinausgeht
Gruß
Lemmi

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Sub SpaltenbreiteAnBilderAnpassen() Dim sh As Shape, lngFaktor As Long For Each sh In ActiveSheet.Shapes If sh.Type = msoPicture Then 'nur bei Bilder und Cliparts lngFaktor = sh.Width / sh.Height sh.Width = Application.Min(sh.Width, 60) sh.Height = sh.Width / lngFaktor If sh.Width > sh.TopLeftCell.Width Then _ sh.TopLeftCell.EntireColumn.ColumnWidth = 70 sh.TopLeftCell.EntireRow.RowHeight = _ Application.Max(sh.Height + 10, sh.TopLeftCell.RowHeight) If sh.Left + sh.Width > sh.TopLeftCell.Left + sh.TopLeftCell.Width Then _ sh.Left = sh.TopLeftCell.Left + 5 If sh.Top + sh.Height > sh.TopLeftCell.Top + sh.TopLeftCell.Height Then _ sh.Top = sh.TopLeftCell.Top + 5 End If Next End Sub

Hallo Lemmi,
genau DAS, was Du da alles schreibst, erfüllt das Makro eigentlich komplett !
ABER : Das Problem liegt wohl eher an der Definition des Wortes "Breite" :
Excel VBA kennt da leider 2 unterschiedliche "Breiten" :
Columns(1).Width (entspricht Shapes(1).Width, Angabe der Breite in Punkten)
Columns(1).ColumnWidth (entspricht Breite in Anzahl Zeichen mit Standardbreite)
Dabei ist z.B. auf meinem Bildschirm Columns(1).width (=371) das gleiche wie Columns(1).ColumnWidth (=70).
In diesem Fall helfen nur etwas konsequentere Umrechnungsfaktoren wie in diesem Makro :

Sub SpaltenbreiteAnBilderAnpassen()
Dim sh As Shape, lngFaktor As Single, lngSpFaktor As Single
For Each sh In ActiveSheet.Shapes
If sh.Type = msoPicture Then 'nur bei Bilder und Cliparts
lngFaktor = sh.Width / sh.Height
lngSpFaktor = sh.TopLeftCell.Width / sh.TopLeftCell.ColumnWidth
sh.Width = Application.Min(sh.Width, 60 * lngSpFaktor)
sh.Height = sh.Width / lngFaktor
If sh.Width > sh.TopLeftCell.Width Then _
sh.TopLeftCell.EntireColumn.ColumnWidth = _
Application.Min(70, sh.Width / lngSpFaktor * 70 / 60)
sh.TopLeftCell.EntireRow.RowHeight = _
Application.Max(sh.Height + 10, sh.TopLeftCell.RowHeight)
If sh.Left + sh.Width > sh.TopLeftCell.Left + sh.TopLeftCell.Width Then _
sh.Left = sh.TopLeftCell.Left + (sh.TopLeftCell.Width - sh.Width) / 2
If sh.Top + sh.Height > sh.TopLeftCell.Top + sh.TopLeftCell.Height Then _
sh.Top = sh.TopLeftCell.Top + 5
End If
Next
End Sub

Gruß, NoNet

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

204 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Zellgröße an Bilder anpassen

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

204 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread