CODEWITHSUNDEEP
excelvbasunburst-diagram
fourthquartermagic
fourthquartermagic

Reputation: 135

How to format Sunburst chart in VBA?

I am trying to format a sunburst chart via VBA. According to the number of Points I want the columns to use one of my colors from green to red.
enter image description here

The data on which the charts builds is specified on another sheet, so I'm formatting the chart once the chart sheet gets activated.

Private Sub Workbook_SheetActivate(ByVal Sh As Object)

    'Only when correct sheet is opened
    If Not Sh.Name = "Radar Chart" Then Exit Sub

    'Do things to find out which data point number is at the core of each column -> coloring this point colors the whole column
    ...

    'Color the sunburst
    Dim chtObj As ChartObject, pts As Points
    Set chtObj = Sh.ChartObjects(1)
    With chtObj.Chart

        '    .ClearToMatchColorStyle -> Runtime error
        '    .ClearToMatchStyle -> Runtime error
        '    .ChartArea.ClearFormats -> Runtime error
            
        Set pts = .SeriesCollection(1).Points
    End With

    'pts(1).ApplyDataLabels (xlDataLabelsShowNone) -> Runtime error
    'pts(2).ClearFormats -> Runtime error

    For i = LBound(arrData, 1) To UBound(arrData, 1)
            
        'arrPairings contains the number of points in column i
        'arrZuordnungErsterPoint contains information on which point column i starts
        Select Case arrpairings(i, 2)
            Case "5":
                pts(arrZuordnungNameErsterPoint(i, 2)).Format.Fill.BackColor.RGB = RGB(68, 154, 54) 'dunkelgrün
            Case "4":
                pts(arrZuordnungNameErsterPoint(i, 2)).Format.Fill.BackColor.RGB = RGB(111, 200, 96) 'hellgrün
            Case "3":
                pts(arrZuordnungNameErsterPoint(i, 2)).Format.Fill.BackColor.RGB = RGB(255, 255, 0) 'gelb
            Case "2":
                pts(arrZuordnungNameErsterPoint(i, 2)).Format.Fill.BackColor.RGB = RGB(255, 127, 80) 'orange
            Case "1":
                pts(arrZuordnungNameErsterPoint(i, 2)).Format.Fill.BackColor.RGB = RGB(255, 0, 0) 'rot
        End Select

        pts(arrZuordnungNameErsterPoint(i, 2)).Format.Fill.Solid
        chtObj.Chart.Refresh 'useless
    Next i

End Sub

Everything works, but only when I'm manually resetting the chart to its template settings before.
Otherwise it will update the height of the column (as the chart does by itself), but will not change the color.

Looking like this:
enter image description here

How can I reset the chart to its template (like when you right-click and manually do so)? Everything I tried results in a Runtime error "does not support this"..

Is there any other event? Maybe the chart gets updated only after the SheetActive event has fired? I tried it via button-click on the sheet itself, no improvement.

Upvotes: 0

Views: 1675

Answers (2)

585
585

Reputation: 1

For i = LBound(arrData, 1) To UBound(arrData, 1)
  pts(arrZuordnungNameErsterPoint(i, 2)).Format.Fill.Solid
  Select Case arrpairings(i, 2)
    Case "5":
      pts(arrZuordnungNameErsterPoint(i, 2)).Format.Fill.ForeColor.RGB = RGB(68, 154, 54) 'dunkelgrün
    Case "4":
      pts(arrZuordnungNameErsterPoint(i, 2)).Format.Fill.ForeColor.RGB = RGB(111, 200, 96) 'hellgrün
    Case "3":
      pts(arrZuordnungNameErsterPoint(i, 2)).Format.Fill.ForeColor.RGB = RGB(255, 255, 0) 'gelb
    Case "2":
      pts(arrZuordnungNameErsterPoint(i, 2)).Format.Fill.ForeColor.RGB = RGB(255, 127, 80) 'orange
    Case "1":
      pts(arrZuordnungNameErsterPoint(i, 2)).Format.Fill.ForeColor.RGB = RGB(255, 0, 0) 'rot
  End Select
Next i

Upvotes: 0

fourthquartermagic
fourthquartermagic

Reputation: 135

Rather accidentally I found a solution.

For reasons which escape me, the command pts(arrZuordnungNameErsterPoint(i, 2)).Format.Fill.Solid blocks VBA from changing the color properly. Using a pattern instead of .Soliddoes the job.

    For i = LBound(arrData, 1) To UBound(arrData, 1)
        pts(arrZuordnungNameErsterPoint(i, 2)).Format.Fill.Patterned msoPattern5Percent

        Select Case arrpairings(i, 2)
            Case "5":
                pts(arrZuordnungNameErsterPoint(i, 2)).Format.Fill.BackColor.RGB = RGB(68, 154, 54) 'dunkelgrün
            Case "4":
                pts(arrZuordnungNameErsterPoint(i, 2)).Format.Fill.BackColor.RGB = RGB(111, 200, 96) 'hellgrün
            Case "3":
                pts(arrZuordnungNameErsterPoint(i, 2)).Format.Fill.BackColor.RGB = RGB(255, 255, 0) 'gelb
            Case "2":
                pts(arrZuordnungNameErsterPoint(i, 2)).Format.Fill.BackColor.RGB = RGB(255, 127, 80) 'orange
            Case "1":
                pts(arrZuordnungNameErsterPoint(i, 2)).Format.Fill.BackColor.RGB = RGB(255, 0, 0) 'rot
        End Select

    Next i

Upvotes: 0

Related Questions