AutoForm per Makro einfügen und anpassen

Hallo,
ich habe in Excel so eine tabellarische Auflistung, die möchte ich grafisch ein bischen aufpeppen.
Die Daten sollen nicht in so eckigen Kästchen stehen Schwarzer Rahmen) ,sondern ich möchte auf jede Zelle, wo was drin steht so eine AutoForm legen, also so ein "abgerundetes Rechteck". Die AutoForm sollte natürlich transparent sein, sonst sind meine Daten im Hintergrund nicht mehr sichtbar.
Die Daten sollen nachher beim Ausdruck in Zellen mit angerundeten Ecken stehen.
Das "abgerundetes Rechteck" (transparent) soll aber "passgenau" in die Zelle eingefügt werden.
Frage1: kann ich eine Autoform so einfügen, damit sie genau so groß wie die Zelle selber ist ?
Frage2: kann man mit einem Makro prüfen, wo überall Text drin steht und dann in jede Zelle so eine passende Autoform einfügen ?
Danke mal
Kai

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Sub xxx() Dim r As Range, s As Shape For Each r In Range("A:A").SpecialCells(xlCellTypeConstants) Set s = ActiveSheet.Shapes.AddShape(msoShapeRoundedRectangle, 1, 1, 1, 1) With s .Width = r.Width .Left = r.Left .Height = r.Height .Top = r.Top .Fill.Visible = False End With Next End Sub

Hallo Rudi,
Sorry, ich habe gerade ein Irrtum entdeckt. Beim Ausführen des Codes habe ich gesehen, dass es ziemlich bescheuert aussieht, wenn zwischen drin eine Zell leer ist und darum der Rahmen fehlt. Dieser müssste dann manuell gesetzt werden.
Wäre ein anderer Ansatz möglich:
In der Spalte B ist bei mir IMMER was drin. Kann das Makro prüfen, :
- ab Zeile 7 in der Spalte B , ob dort was drin steht. Wenn ja, überall in der Zeile 7 im Range("B7:F7") diesen Rahmen setzen (nach den Grössen der Zellen, so wie gehabt)
- dann zur nächste Zeile (B8) prüfen, ob Inhalt, wenn ja, im Range("B8:F8") wieder den Rahmen setzen.
usw.
Wenn in B eine Zelle leer ist, kann davon ausgegangen werden, das Ende der Tabelle ist erreicht.
So würde auch ein rahmen gesetzt, wenn zwischendrin mal eine Zelle nicht befüllt ist.
Danke
Kai

Sub xxx() Dim rngC As Range, r As Range, s As Shape Application.ScreenUpdating = False For Each rngC In Range(Cells(7, 2), Cells(Rows.Count, 2).End(xlUp)) For Each r In rngC.Resize(, 5) Set s = ActiveSheet.Shapes.AddShape(msoShapeRoundedRectangle, 1, 1, 1, 1) With s .Width = r.Width .Left = r.Left .Height = r.Height .Top = r.Top .Fill.Visible = False End With Next r Next rngC End Sub

Beliebteste Forumthreads (12 Monate)

AutoForm per Makro einfügen und anpassen

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

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread