Bilder mittig in Zellen ausrichten

[Flammkuchen]

Hallo zusammen,

ich stehe vor einem kleinen Problem.
Und zwar hab ich für ein Projekt eine Excel Tabelle erstellt, bei dem ich einem jeden Bauteil ein Bild zugeordnet habe.
Das Bild habe ich frei Hand in die Zellen eingefügt.

Jetzt hätte ich gerne, dass diese Bilder innerhalb der Zellen zentriert sind.
Die Bilder sind dabei kleiner als die Zelle, damit man die Ränder noch erkennen kann.

Mit den Standardtools aus Excel ist dies anscheinend nicht möglich.
Nach einiger Recherche hab ich folgendes gefunden:

http://vbanet.blogspot.de/2008/11/pictures-centers.html

Leider hab ich keine Erfahrung mit VBA oder Makros.
Könnte mir jemand helfen, wie ich das umsetzen kann?

Vielen Dank schonmal im Voraus!

Grüße
Sebastian

[Fennek]

Hallo,

weil dein NickName lecker schmeckt:

Case schreibt einen sehr schönen, eigentlich gut lesbaren Code.

Öffne den VBA-Editor mit alt-F11 und lege ein neues Modul an mit alt-e-m (nacheinander oder im Menü).

Dort wird der Code von Case mit copy/paste eingefügt:

Code:

Public Sub Picture_Center_Name()
   Dim shpPicture As Shape
   With ThisWorkbook.Worksheets("Sheet1")
       For Each shpPicture In .Shapes
           If shpPicture.Type = msoPicture Then
               shpPicture.Left = shpPicture.Left + _
                   (shpPicture.TopLeftCell.Width - _
                   shpPicture.Width) / 2
               shpPicture.Top = shpPicture.Top + _
                   (shpPicture.TopLeftCell.Height - _
                   shpPicture.Height) / 2
           End If
       Next shpPicture
   End With
End Sub

Teste den Code im einzelschritt-Modus F8, falls Probleme auftreten, lade deine Datei hoch.

mfg

[Flammkuchen]

Danke für die Antwort!

Ich muss gestehen, dass ich mich bisher nicht wirklich mit der Makroprogrammierung auskenne.
Möchte mich aber mehr damit beschäftigen.

Ich hab das mit F8 jetzt durchgespielt.
Die Bilder werden zwar verschoben, aber gleiten dabei immer mehr nach rechts ab anstatt zentriert zu werden

[RPP63]

Moin!
Wundert mich wirklich, dass Case so ein Lapsus auf seiner Site passiert ist.

Hier mal der richtige Code:
Modul Modul1

Option Explicit 
 
Public Sub Picture_Center_Name() 
   Dim shpPicture As Shape 
   With ThisWorkbook.Worksheets("Sheet1") 
       For Each shpPicture In .Shapes 
           If shpPicture.Type = msoPicture Then 
               shpPicture.Left = shpPicture.TopLeftCell.Left + _
                   (shpPicture.TopLeftCell.Width - _
                   shpPicture.Width) / 2 
               shpPicture.Top = shpPicture.TopLeftCell.Top + _
                   (shpPicture.TopLeftCell.Height - _
                   shpPicture.Height) / 2 
           End If 
       Next shpPicture 
   End With 
End Sub 
 

Gruß Ralf

[Flammkuchen]

Hey RPP63!

Vielen Dank für die tolle Hilfe!
Und dann einfach F gedrückt halten, bis es überall angewendet ist?

Wie funktionert das jetzt, wenn ich zwei oder mehr Arbeitsmappen in einem Dokument habe?

PS: Gutes Buch für Programmierung in Excel?  Würde mich gerne einlesen und lernen

[RPP63]

Und dann einfach F gedrückt halten, bis es überall angewendet ist?

In der Regel startet man ein (vorher getestetes) Makro so:
Alt+F8
Makro wählen, ausführen.

Wie funktionert das jetzt, wenn ich zwei oder mehr Arbeitsmappen in einem Dokument habe?

Du meinst wahrscheinlich mehrere Tabellenblätter (Sheets) in einer Arbeitsmappe (Workbook).
Dazu gibt es in Deinem Link ja das Makro Picture_Center_All_Worksheet()
Beachte aber, dass der Fehler auch dort besteht und äquivalent zu meinem Code geändert werden muss.

Gruß Ralf

[Fennek]

Hallo,

teste diesen Code:

Code:

Public Sub Picture_Center_Name()
  Dim shpPicture As Shape
  With ThisWorkbook.Worksheets("Sheet1")
      For Each shpPicture In .Shapes
      'Debug.Print shpPicture.Name, shpPicture.TopLeftCell.Address
          If shpPicture.Type = msoPicture Then
          shpPicture.Left = shpPicture.TopLeftCell.Left
          shpPicture.Top = shpPicture.TopLeftCell.Top
              shpPicture.Left = shpPicture.Left + _
                  (shpPicture.TopLeftCell.Width - _
                  shpPicture.Width) / 2
              shpPicture.Top = shpPicture.Top + _
                  (shpPicture.TopLeftCell.Height - _
                  shpPicture.Height) / 2
          End If
      Next shpPicture
  End With
End Sub

Die Bilder müssen kleiner sein als die Zelle (könnte man auch automatisieren) und irgentwie in der richtigen Zelle der Spalte D stehen.

mfg

(ergänzt: der Code von Case funktioniert, wenn man zuerst das Bild in die obere linke Ecke setzt)

[RPP63]

@Fennek:
Warum weist Du zweimal .Top bzw. .Left zu?
Hast Du "meinen" Code (#4) nicht gesehen?

Gruß Ralf

[Guschti]

Grüezi Sebastian

Hier ein Code von Nepumuk, auch kürzer

Code:

Option Explicit
Public Sub Center_Picture()
     Dim objShape As Shape
     For Each objShape In Tabelle1.Shapes
         With objShape
             If .Type = msoPicture Then
                 .Left = .TopLeftCell.Left + .TopLeftCell.Width / 2 - .Width / 2
                 .Top = .TopLeftCell.Top + .TopLeftCell.Height / 2 - .Height / 2
             End If
         End With
     Next
 End Sub

Gruss Guschti