Как отформатировать диаграмму Sunburst в VBA? - PullRequest
0 голосов
/ 12 марта 2020

Я отчаянно пытаюсь отформатировать диаграмму солнечных лучей через VBA. В зависимости от количества точек, я хочу, чтобы столбцы использовали один из моих цветов от зеленого до красного.

enter image description here

Данные, на которых построены графики указан на другом листе, поэтому я форматирую диаграмму, как только лист диаграммы активируется.

    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

Моя проблема сейчас: Все работает как шарм, но только когда я вручную сбрасываю график с настройками шаблона до . В противном случае он обновит высоту столбца (как это делает сама диаграмма), но не изменит цвет. Выглядит так:

enter image description here

Как я могу сбросить график к его шаблону (например, когда вы щелкаете правой кнопкой мыши и делаете это вручную)? Все, что я пробовал, приводит к ошибке Runtime "не поддерживает это" ..

Есть ли еще какое-нибудь более многообещающее событие, которое я мог бы использовать? Может быть, диаграмма обновляется только после того, как сработало событие SheetActive? Я попробовал это с помощью нажатия кнопки на самом листе, но без улучшения.

Меня действительно смущает поведение такого рода диаграмм. Макро-рекордер почти бесполезен. Я также нахожу очень мало документации о солнечных ожогах, так что вы моя последняя надежда. Любая помощь приветствуется!

1 Ответ

0 голосов
/ 12 марта 2020

Довольно случайно я нашел решение.

По причинам, которые меня избегают, команда pts(arrZuordnungNameErsterPoint(i, 2)).Format.Fill.Solid блокирует VBA от правильного изменения цвета. Использование шаблона вместо .Solid делает работу.

    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
...