Excel-根据数据表中的值有条件地在图表上设置.DataLabel属性的格式

时间:2019-12-03 01:38:01

标签: excel vba object charts formatting

我试图同时使用VBA和添加多个数据序列来执行此操作,但是我认为由于图表类型的缘故,我必须使用VBA。我正在使用以下模板:https://templates.office.com/en-au/project-timeline-with-milestones-tm00000009。在数据表上,我添加了附加列“类别”,其中包含特定“里程碑”所属的五个不同类别之一。我已经对图表上的数据标签进行了格式设置,使其后面具有填充颜色,并且我希望能够根据表中里程碑所在的类别来更改颜色。

非常感谢您的帮助!

1 个答案:

答案 0 :(得分:0)

检查此代码的注释并对其进行自定义以满足您的需求

enter image description here

将其放在保存图表的表格后面:

enter image description here

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    ' Declare object variables
    Dim evalTable As ListObject

    ' Declare other variables
    Dim sheetName As String
    Dim tableName As String
    Dim categoryColumnNumber As Long
    Dim chartPointNum As Long

    ' Customize to fit your needs
    sheetName = "Project Timeline"
    tableName = "ProjectDetails"
    categoryColumnNumber = 6

    ' Initialize table that holds chart data
    Set evalTable = ThisWorkbook.Sheets(sheetName).ListObjects(tableName)

    ' Check if current cell changed belongs to column where categories are defined
    If Not Intersect(Target, evalTable.DataBodyRange.Columns(categoryColumnNumber)) Is Nothing Then

        ' Get the data label number based on cell's position among table
        chartPointNum = Target.Row - evalTable.HeaderRowRange.Row

        ' Set data label background color based on changed cell and it's position
        SetDataLabelColor Target, chartPointNum

    End If

End Sub


Public Sub SetDataLabelColor(TargetCell As Range, chartPointNum As Long)

    Dim evalChart As ChartObject

    Set evalChart = ActiveSheet.ChartObjects("Project Timeline")

    With evalChart.Chart.FullSeriesCollection(2).Points(chartPointNum).DataLabel.Format.Fill
        .Visible = msoTrue
        ' Credits: https://stackoverflow.com/a/28058868/1521579
        .ForeColor.RGB = RGB((TargetCell.Interior.Color Mod 256), ((TargetCell.Interior.Color \ 256) Mod 256), (TargetCell.Interior.Color \ 65536))
        .Transparency = 0
        .Solid
    End With
End Sub

如果这有帮助,请记住标记答案