VBA中的Excel堆积条形图-基于“类别”的堆积条的颜色编码

时间:2019-05-28 17:39:48

标签: excel vba

我正在尝试使用VBA对堆叠的3D条形图的颜色进行编码 同样的方法。 OPEN发行带有白色字体的红色,CONTAINED发行带有黑色字体的橙色, 带有黑色字体的黄色的MONITOR问题,带有黑色字体的绿色的OPEN问题。

重要提示:源数据的范围可能是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

0 个答案:

没有答案