HERBERS

Excel-Forum (Archiv)

20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender

Rückwärts Blättern

Aktuelles Verzeichnis

Übersicht Verzeichnisse

Nächster Thread

Vorwärts blättern

Inhaltsverzeichnis

Bild über Zelle platzieren und Größe an Zelle anpassen

Forumthread: Bild über Zelle platzieren und Größe an Zelle anpassen
12 Beiträge zu diesem Forumthread
Anzeige

Forumthread: Bild über Zelle platzieren und Größe an Zelle anpassen

16.04.2025 18:13:42

{Boris}

Hallo zusammen,

ich habe eine Datei, in der Bilder IN der Zelle platziert sind (Feature seit xl365) - und zwar unterschiedlich viele.
Jetzt haben nicht alle Kunden die Version 365, so dass ich die Bilder aus der Zelle rausholen muss, damit sie sie sehen können.

Das mache ich mit:

Sub BildUeberZellePlatzieren()

Dim C As Range

For Each C In Tabelle1.UsedRange

    If BildInZelle(C) Then

        C.PlacePictureOverCells

    End If

Next C

End Sub



Function BildInZelle(DieZelle As Range) As Boolean

BildInZelle = DieZelle.HasRichDataType

End Function

Problem: Die so rausgeholten Bilder gehen über die Zellgrenzen hinaus.
Frage: Wie kann ich im selben "Arbeitsschritt" die rausgeholten Bilder an die Zellgrenzen anpassen?

Anbei eine Beispieldatei mit 2 Bildern.

https://www.herber.de/bbs/user/176761.xlsm

Danke vorab für Euren Input!

VG, Boris

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Bild über Zelle platzieren und Größe an Zelle anpassen

16.04.2025 18:41:17

daniel
Perfekt!

17.04.2025 12:54:55

{Boris}
Noch eine Nachfrage

17.04.2025 13:23:07

{Boris}
AW: Noch eine Nachfrage

17.04.2025 13:29:22

daniel
AW: Noch eine Nachfrage

17.04.2025 13:50:53

{Boris}
Habe jetzt eine Lösung

17.04.2025 14:04:41

{Boris}
AW: Habe jetzt eine Lösung

17.04.2025 20:27:04

Uduuh
Super...

18.04.2025 14:22:51

{Boris}
Habe jetzt auch dafür eine Lösung gefunden...

18.04.2025 16:47:33

{Boris}
Eine (hoffentlich) letzte Nachfrage

18.04.2025 16:20:13

{Boris}
AW: Eine (hoffentlich) letzte Nachfrage

18.04.2025 16:44:09

Piet
AW: Eine (hoffentlich) letzte Nachfrage

18.04.2025 16:51:58

{Boris}

AW: Bild über Zelle platzieren und Größe an Zelle anpassen

16.04.2025 18:41:17

daniel

Hi
du kannst hinterher nochmal dieses Makro laufen lassen, es verkleinert die Bilder so, dass sie in die Zelle passen, in der sich die linke obere Ecke befindet.
das anpassen einer Größe sollte ausreichen, da meines wissen nach es die Grundeinstellung ist, ein Bild automatisch in beiden Dimensionen in der Größe anzupassen, wenn man eine ändert

Dim s

Dim a As Double, b As Double

For Each s In ActiveSheet.Shapes

    If s.Name Like "Picture*" Then

        a = s.Height / s.TopLeftCell.Height

        b = s.Width / s.TopLeftCell.Width

        s.Height = s.Height / WorksheetFunction.Max(a, b)

    End If

Next

Gruß Daniel

Perfekt!

17.04.2025 12:54:55

{Boris}

Hi Daniel,

sorry für die späte Rückmeldung. Das funktioniert perfekt!
Da sich manche Bilder in verbundenen Zelle befinden, habe ich den Code noch um die MergeArea erweitert:

s.TopLeftCell.MergeArea.Height
bzw.
s.TopLeftCell.MergeArea.Width

Das funktioniert so auch in Zellen, die nicht verbunden sind.

Nochmal: Klasse und vielen Dank!

VG, Boris

Noch eine Nachfrage

17.04.2025 13:23:07

{Boris}

Hi Daniel,

weißt Du eventuell auch noch, woran es liegt, dass Excel bei manchen Bildern offensichtlich die TopLeftCell nicht erkennt?
Anbei ein Fotobeispiel:

Oben ist es so, wie ich es (in xl365) per Formel mache.

Basierend auf dieser Datei hole ich die Bilder wie gepostet aus den Zellen und passe die Größen an - mit Deinem Code.

Vereinzelt kommt es dann zu solchen "Verschiebungen" wie beim rechten Artikel unten. Das ist jetzt kein Drama, weil man die jetzt noch manuell verschieben kann - wäre aber halt toll, wenn das gar nicht so vorkäme.

Hast Du dazu noch eine Idee?

Oben: Vorher (per Formel)
Unten: Nachher (wenn die Bilder aus den Zellen geholt worden sind)

Userbild

VG, Boris

AW: Noch eine Nachfrage

17.04.2025 13:29:22

daniel

Hi
jedes Bild, das auf einem Tabellenblatt liegt, hat eine TopLeftCell.
ich benutze diese, nur um die Größe des Bildes zu ändern, aber nichts an der Position.
die Position der linken oberen Ecke des Bildes sollte dort sein, wo dein Makro das Bild platziert hat.
also prüfe erstmal, ob nach durchlauf des ersten Makros die Bilder richtig plaziert sind.
Gruß Daniel

AW: Noch eine Nachfrage

17.04.2025 13:50:53

{Boris}

Hi Daniel,

danke für Deine Antwort. Habe es getestet - die TopLeftCell ist J4 (korrekt).
Aber es ist merkwürdig: Wenn ich Die Datei erst einmal erstellt und gespeichert habe und anschließend Deinen Code laufen lasse, ist am Ende alles korrekt.
Ich muss also nochmal meinen Code checken.

Danke Dir!

VG, Boris

Habe jetzt eine Lösung

17.04.2025 14:04:41

{Boris}

Hi Daniel,

habe jetzt in meiner Schleife das WorkSheet jeweils aktiviert - und damit funktioniert es dann problemlos (warum auch immer):

Sub Ausrichten()

Dim s

Dim a As Double, b As Double

Dim Ws As Worksheet

For Each Ws In ThisWorkbook.Worksheets

    Ws.Activate

    For Each s In Ws.Shapes

        If s.Name Like "Picture*" Then

            a = s.Height / s.TopLeftCell.MergeArea.Height

            b = s.Width / s.TopLeftCell.MergeArea.Width

            s.Height = s.Height / WorksheetFunction.Max(a, b)

        End If

    Next s

Next Ws

End Sub

Eine letzte Luxusfrage (ist wirklich nicht so wichtig):

Aktuell werden die Bilder in den Zellen links oben ausgerichtet (TopLeftCell). Ließe sich die Ausrichtung auch mittig (sowohl vertikal als auch horizontal) erzeugen?
Das wäre nur noch ein "nice to have" - aber nicht wirklich notwendig.

Viele Grüße

Boris

AW: Habe jetzt eine Lösung

17.04.2025 20:27:04

Uduuh

Hallo,
ganz einfach:
s.Left = s.TopLeftCell.MergeArea.Left + (s.TopLeftCell.MergeArea.Width - s.Width) / 2

.Top analog.

Gruß aus'm Pott
Udo

Super...

18.04.2025 14:22:51

{Boris}

Hi Udo,

vielen Dank - so ist es jetzt perfekt!

VG, Boris

Habe jetzt auch dafür eine Lösung gefunden...

18.04.2025 16:47:33

{Boris}

Hi Udo, hi @all,

ich übergebe der Sub zusätzlich die TopLeftCell des Shapes mit der Variablen TLC.
Damit funktioniert es dann wie gewünscht.
Es bleibt mir aber ein Rätsel, weshalb es anders nicht läuft bzw. die TopfLetCell ihren Fokus verliert.

Sub Ausrichten_einzeln(DasShape As Shape, TLC As Range, DieTabelle As Worksheet)

'Richtet ein Bild in einer bestimmten Tabelle horizontal und vertikal an die Zellgrenzen aus

Dim a As Double, b As Double

Application.ScreenUpdating = True

DieTabelle.Activate 'muss sein - warum auch immer, da ansonsten manche Bilder nicht korrekt platziert werden

a = DasShape.Height / TLC.MergeArea.Height

b = DasShape.Width / TLC.MergeArea.Width

DasShape.Height = DasShape.Height / WorksheetFunction.Max(a, b)

DasShape.Left = TLC.MergeArea.Left + (TLC.MergeArea.Width - DasShape.Width) / 2

DasShape.Top = TLC.MergeArea.Top + (TLC.MergeArea.Height - DasShape.Height) / 2

End Sub

VG, Boris

Eine (hoffentlich) letzte Nachfrage

18.04.2025 16:20:13

{Boris}

Hi Udo,

es klappt in der Datei mit allen Bildern perfekt - bis auf 1 Bild in einem bestimmten Blatt.
Dieses Bild wird mit einem einfachen SVERWEIS in Zelle A4 ausgelesen, dann aus der Zelle "rausgeholt" und die Größe angepasst.
Die Zelle A4 ist auch nicht verbunden sondern einfach nur groß gezogen.

Beim Anpassen der Größe verliert der Code bzw. das Bild aber die TopLeftCell.
Ich habe sie im Code 3 mal im Direktfenster ausgegeben:
Zu Beginn ist sie mit A4 (korrekt), nach der ersten Aktion aber plötzlich A3 und am Ende A1. Damit ist dieses Bild nicht mehr korrekt platziert.

Die Datei ist leider recht komplex und vertraulich - daher die Frage, ob Du auch so irgendeine Idee hast, was ich im Code noch ändern könnte.

Für die Sub übergebe ich a) das Shape und b) das Tabellenblatt.

Userbild

VG, Boris

AW: Eine (hoffentlich) letzte Nachfrage

18.04.2025 16:44:09

Piet

Hallo Borsi

bei den komplexen Codes die ihr da herausgefunden habt komme ich mit meinem bescheidenen Wissen nicht mehr mit!
Ich experimentiere aber gerne wenn es kniffelig wird. Vielleicht reicht dir ein gedanklicher Anreiz zum verbessern des Codes.

Um Button in die Zellel zu zentrieren liste ich sie mit VBA auf, und setze sie mit VBA im 0,75 Step gezielt in die Mitte.
Ist zwar ein bisschen rum experimentieren, aber man sieht sofort wo danach der Button oder das Bild sitzt.
Auflisten: Cells(z, 3) = ActiveSheet.Shapes(j).Top --> Neu setzen: ActiveSheet.Shapes(j).Top = Cells(z, 3)

mfg Piet

AW: Eine (hoffentlich) letzte Nachfrage

18.04.2025 16:51:58

{Boris}

Hi Piet,

danke für Deine Antwort!
Ich hab jetzt eine Lösung gefunden (siehe separater Kommentar von mir) - weiß aber immer noch nicht so recht, warum das so nötig ist.
Aber es läuft - das ist die Hauptsache.

VG, Boris

Jetzt das Excel-Portal bewerten: Deine Stimme zählt!