Tabelle in Grafik darstellen

Forumthread: Tabelle in Grafik darstellen

21.06.2017 13:00:19

gegs2

Hallo,
anhängend habe ich eine Tabelle mit verschiedenen einträgen welche ich ein mehreren Grafiken darstellen muss.
In Tabelle1 bekomme ich eine Liste mit den drei Spalten Nr, Typ und Farbe gefüllt. Diese Zeilen sollen nun wie in Tabelle2 beispielhaft dargestellt werden.
Mir kommt kein vernünftiger Gedanke wie ich dies angehen soll.
Vielleicht hat jemand einen Ansatzpunkt, dafür wäre ich sehr dankbar.
Viele Grüße
Gerhard
https://www.herber.de/bbs/user/114390.xlsx

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Tabelle in Grafik darstellen

21.06.2017 18:50:49

Michael
AW: Tabelle in Grafik darstellen

22.06.2017 07:27:02

gegs2
Ja, da war noch ein Fehler...

22.06.2017 09:54:52

Michael
AW: Ja, da war noch ein Fehler...

22.06.2017 11:34:07

gegs2

AW: Tabelle in Grafik darstellen

21.06.2017 18:50:49

Michael

Hallo Gerhard!
Hier mal als quick-and-dirty Lösung, ist noch nicht optimiert: https://www.herber.de/bbs/user/114400.xlsm
Ist auf Basis Deiner Bsp-Datei; starte Makro "a" und schau mal in Tabelle2.
Der Code:

Sub a()
Dim Wb As Workbook: Set Wb = ThisWorkbook
Dim WsQ As Worksheet: Set WsQ = Wb.Worksheets("Tabelle1")
Dim WsZ As Worksheet: Set WsZ = Wb.Worksheets("Tabelle2")
Dim Dat As Range, Ite As Range, t$, s As Shape
Set Dat = WsQ.Range("A2:A" & WsQ.Cells(WsQ.Rows.Count, 1).End(xlUp).Row)
Debug.Print Dat.Cells.Count
For Each Ite In Dat
t = Ite.Value & Chr(10) & Chr(10) & Ite.Offset(, 1).Value
With WsZ
Set s = .Shapes.AddShape(msoShapeRectangle, _
.Cells(1, Ite.Value).Left, _
.Cells(1, Ite.Value).Top, _
.Cells(1, Ite.Value).Width, _
.Cells(1, Ite.Value).Height * 5)
s.Select
With Selection
.ShapeRange.TextFrame2.TextRange.Characters.Text = t
.ShapeRange.TextFrame2.TextRange.ParagraphFormat.Alignment = _
msoAlignCenter
.ShapeRange.TextFrame2.TextRange.Characters(1, 1).Font.Bold = msoFalse
.ShapeRange.TextFrame2.TextRange.Characters(1, 1).Font.Bold = msoTrue
.ShapeRange.Fill.ForeColor.RGB = Ite.Offset(, 2).Interior.Color
End With
Set s = .Shapes.AddShape(msoShapeOval, _
.Cells(1, Ite.Value).Left, _
.Cells(1, Ite.Value).Top, _
.Cells(1, Ite.Value).Width, _
.Cells(1, Ite.Value).Height * 5 / 3 * 2)
s.Select
With Selection
.ShapeRange.Fill.Visible = msoFalse
.ShapeRange.Line.Visible = msoTrue
.ShapeRange.Line.Weight = 2.25
.ShapeRange.Line.ForeColor.RGB = vbWhite
End With
End With
Next Ite
End Sub

Aber als Starthilfe sollt's mal reichen, die Spielereien darfst gerne Du übernehmen ;-), ich bin mal im Feierabend.
LG
Michael

AW: Tabelle in Grafik darstellen

22.06.2017 07:27:02

gegs2

Guten Morgen Michael,
herzlichen Dank für den Lösungsvorschlag, hiermit komme ich schon mal ein Stück weiter.
Das Makro läuft zwar nach "With Selection" noch auf Fehler, das werde ich aber irgendwie hin bekommen.
Vielen Dank und liebe Grüße
Gerhard

Ja, da war noch ein Fehler...

22.06.2017 09:54:52

Michael

Gerhard,
...so sollte der Code auf jeden Fall mal klappen:

Sub a()
Dim Wb As Workbook: Set Wb = ThisWorkbook
Dim WsQ As Worksheet: Set WsQ = Wb.Worksheets("Tabelle1")
Dim WsZ As Worksheet: Set WsZ = Wb.Worksheets("Tabelle2")
Dim Dat As Range, Ite As Range, t$, s As Shape
Set Dat = WsQ.Range("A2:A" & WsQ.Cells(WsQ.Rows.Count, 1).End(xlUp).Row)
WsZ.Activate
For Each Ite In Dat
t = Ite.Value & Chr(10) & Chr(10) & Ite.Offset(, 1).Value
With WsZ
Set s = .Shapes.AddShape(msoShapeRectangle, _
.Cells(1, Ite.Value).Left, _
.Cells(1, Ite.Value).Top, _
.Cells(1, Ite.Value).Width, _
.Cells(1, Ite.Value).Height * 5)
s.Select
With Selection
.ShapeRange.TextFrame2.TextRange.Characters.Text = t
.ShapeRange.TextFrame2.TextRange.ParagraphFormat.Alignment = _
msoAlignCenter
.ShapeRange.TextFrame2.TextRange.Characters(1, 1).Font.Bold = msoFalse
.ShapeRange.TextFrame2.TextRange.Characters(1, 1).Font.Bold = msoTrue
.ShapeRange.Fill.ForeColor.RGB = Ite.Offset(, 2).Interior.Color
End With
Set s = .Shapes.AddShape(msoShapeOval, _
.Cells(1, Ite.Value).Left, _
.Cells(1, Ite.Value).Top, _
.Cells(1, Ite.Value).Width, _
.Cells(1, Ite.Value).Height * 5 / 3 * 2)
s.Select
With Selection
.ShapeRange.Fill.Visible = msoFalse
.ShapeRange.Line.Visible = msoTrue
.ShapeRange.Line.Weight = 2.25
.ShapeRange.Line.ForeColor.RGB = vbWhite
End With
End With
Next Ite
End Sub

Wie gesagt, der Rest sind dann Optimierungen.
LG
Michael

AW: Ja, da war noch ein Fehler...

22.06.2017 11:34:07

gegs2

.... funktioniert nun bestens
Vielen Dank und liebe Grüße
Gerhard

Beliebteste Forumthreads (12 Monate)

Forumthread: Tabelle in Grafik darstellen

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread