Tabelle in Grafik darstellen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

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

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

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Tabelle in Grafik darstellen

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

300 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread