Сложенная гистограмма Excel в VBA - цветовая кодировка сгруппированных столбцов на основе «категорий» - PullRequest
0 голосов
/ 28 мая 2019

Я пытаюсь закодировать в VBA цвета гистограммы с накоплением так же. ОТКРЫТЫЙ номер красный с белым шрифтом, СОДЕРЖАНИЕ номер оранжевый с черным шрифтом, МОНИТОР выдает желтый с черным шрифтом, ОТКРЫТЫЙ - зеленый с черным шрифтом.

Важно: исходные данные могут находиться в диапазоне от 0 до 100, и это не предвидится, сколько у меня будет суммированных точек / данных. Моя проблема в том, что независимо от того, что я пытаюсь, я не могу разработать правильный код и бары не окрашены правильно.

Смотри мой код. Что я делаю неправильно? Кажется, я не получаю очки, только имена.

Option Explicit
Sub StackedBarChart3D()

Dim ocmc As Range
Dim SumCategories, NoOfZerosInRow As Long
Dim i As Long

    ' Calculate how many categories I truly have
    ' Probably could be done more elgegant, but it works
    Set ocmc = Sheets("Graph").Range("E2:H2")
    ocmc = Empty
    With Worksheets("Graph")
        ' Count sum of all issues per category
        Range("E2") = WorksheetFunction.Sum(.Range("E4:E7"))
        Range("F2") = WorksheetFunction.Sum(.Range("F4:F7"))
        Range("G2") = WorksheetFunction.Sum(.Range("G4:G7"))
        Range("H2") = WorksheetFunction.Sum(.Range("H4:H7"))
        ' Counts how many issue categores I have
        SumCategories = WorksheetFunction.CountA(.Range("E2:H2"))
        ' The sum function above leaves zeroes if no issues are within the category
        ' For total issue category count, I need to substract the ones that contain '0'
        NoOfZerosInRow = CountZeros(ocmc)
        SumCategories = SumCategories - NoOfZerosInRow
    End With

' ISSUE IS WITHIN NEXT LINES OF CODE:
' =====================================================
 ' Reformat all bar colors and labels
    With Sheets("Graph").ChartObjects("Chart_2a").Chart
        For i = 1 To SumCategories ' loop through all series
            With .SeriesCollection(i)
                    If .Name = "Open" Then
                        .Interior.Color = RGB(255, 0, 0)
                        .HasDataLabels = True
                        .DataLabels.ShowValue = True
                        .DataLabels.Font.Name = "Calibri"
                        .DataLabels.Font.Size = 14
                        .DataLabels.Font.Bold = True
                        .DataLabels.Font.Color = RGB(255, 255, 255)
                    End If
                    If .Name = "Contained" Then
                        .Interior.Color = RGB(255, 255, 0)
                        .HasDataLabels = True
                        .DataLabels.ShowValue = True
                        .DataLabels.Font.Name = "Calibri"
                        .DataLabels.Font.Size = 14
                        .DataLabels.Font.Bold = True
                        .DataLabels.Font.Color = RGB(89, 89, 89)
                    End If
                    If .Name = "Monitor" Then
                        .Interior.Color = RGB(255, 255, 0)
                        .HasDataLabels = True
                        .DataLabels.ShowValue = True
                        .DataLabels.Font.Name = "Calibri"
                        .DataLabels.Font.Size = 14
                        .DataLabels.Font.Bold = True
                        .DataLabels.Font.Color = RGB(89, 89, 89)
                    End If
                    If .Name = "Closed" Then
                        .Interior.Color = RGB(0, 208, 0)
                        .HasDataLabels = True
                        .DataLabels.ShowValue = True
                        .DataLabels.Font.Name = "Calibri"
                        .DataLabels.Font.Size = 14
                        .DataLabels.Font.Bold = True
                        .DataLabels.Font.Color = RGB(89, 89, 89)
                    End If
            End With
        Next i
    End With
End Sub

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...