Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema Frame
BildScreenshot zu Frame Frame-Seite mit Beispielarbeitsmappe aufrufen

Tabelle in Grafik darstellen


Betrifft: Tabelle in Grafik darstellen von: gegs2
Geschrieben am: 21.06.2017 13:00:19

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

  

Betrifft: AW: Tabelle in Grafik darstellen von: Michael (migre)
Geschrieben am: 21.06.2017 18:50:49

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


  

Betrifft: AW: Tabelle in Grafik darstellen von: gegs2
Geschrieben am: 22.06.2017 07:27:02

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


  

Betrifft: Ja, da war noch ein Fehler... von: Michael (migre)
Geschrieben am: 22.06.2017 09:54:52

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


  

Betrifft: AW: Ja, da war noch ein Fehler... von: gegs2
Geschrieben am: 22.06.2017 11:34:07

.... funktioniert nun bestens

Vielen Dank und liebe Grüße
Gerhard


Beiträge aus den Excel-Beispielen zum Thema "Tabelle in Grafik darstellen"