读取图表标签值运行时错误(Excel VBA)

时间:2014-08-13 13:00:16

标签: excel vba excel-vba

我有下表,我正在创建一个图表:

Table http://i57.tinypic.com/2ptp7yq.png

添加图表后,我想根据标签值为图表栏着色,如果标签的值为0,则标签应更改为“OFF”。

以下是我的代码:

Dim ChartRng As Range

Set ChartRng = Worksheets("Overview").Range("A1:C19")

Dim oChtObj As ChartObject
Set oChtObj = Worksheets("Overview").ChartObjects.Add(Left:=48, Width:=570, Top:=1000, Height:=367)

With oChtObj.Chart
    .Parent.Name = "Performance"
    .ChartType = xlColumnClustered
    .ApplyLayout (1)
    .SetSourceData ChartRng
    .HasLegend = True
    .SeriesCollection(1).HasDataLabels = True
    .SeriesCollection(2).HasDataLabels = False
    .HasTitle = True
    .ChartTitle.Caption = "Call Facing Time (KPI: 75%) Per Agent"
    .ChartTitle.Font.Size = 16
    .ChartTitle.Font.Color = RGB(84, 84, 84)
    .SeriesCollection(1).Name = "CFT"
    .SeriesCollection(2).Name = "KPI"
    .SeriesCollection(2).ChartType = xlLine
    .ChartStyle = 26
    .Axes(xlCategory).HasMinorGridlines = False
    .Axes(xlCategory).HasMajorGridlines = False
    .Axes(xlValue).HasMinorGridlines = False
    .Legend.LegendEntries(1).Delete
    .SeriesCollection(2).Border.Color = RGB(37, 64, 97)
    .SeriesCollection(2).Format.Line.Weight = 3
    .Axes(xlValue).TickLabels.Font.Size = 9
    .Axes(xlCategory).TickLabels.Font.Size = 9
    .Axes(xlValue).TickLabels.Font.Color = RGB(77, 77, 77)
    .Axes(xlCategory).TickLabels.Font.Color = RGB(77, 77, 77)
    .Legend.Position = xlBottom
    .Legend.Font.Size = 9
    .SeriesCollection(1).DataLabels.Font.Size = 9
    .ChartArea.Border.Color = RGB(217, 217, 217)
    .Axes(xlValue).MajorGridlines.Border.Color = RGB(217, 217, 217)
End With

Set oChtObj = Nothing

Dim oPoint As Excel.Point
Dim sngPercente As Single

For Each oPoint In Worksheets("Overview").ChartObjects("Performance").Chart.SeriesCollection(1).Points
sngPercente = CSng(Split(oPoint.DataLabel.Caption, "%")(0))

With oPoint
If sngPercente < 70 Then
.Interior.Color = RGB(255, 0, 0)
End If
If sngPercente > 75 Then
.Interior.Color = RGB(0, 176, 80)
End If
If sngPercente >= 70 And sngPercente <= 75 Then
.Interior.Color = RGB(148, 208, 80)
End If
If sngPercente = 0 Then
.DataLabel.Caption = "OFF"
End If
End With

Next oPoint

出于某种原因,我在第sngPercente = CSng(Split(oPoint.DataLabel.Caption, "%")(0))行获得了以下错误:

Error http://i60.tinypic.com/rmiwdh.png

我也尝试使用Split(oPoint.DataLabel.Text,但仍然出错。

值得注意的是,在Excel 2013中查看时,相同的代码运行正常,但它在2007年出现了上述错误。

任何帮助了解错误背后的原因或可能的解决方法都将受到高度赞赏。

2 个答案:

答案 0 :(得分:1)

我不确定Excel 2007是否具有Datalabel.Caption属性,因为我无法测试它。

试试这个

添加此行

Worksheets("Overview").ChartObjects("Performance").Chart.SeriesCollection(1).HasDataLabels = True

For Each oPoint In Worksheets("Overview").....循环之前,现在尝试一下。

如果仍然无效,我将删除此帖子。

修改

根据THIS,此属性存在于Office 2007

Teamviewer的进一步测试显示,在此版本中,您必须首先选择Datalabel才能读取它的值。所以我们所要做的就是添加

oPoint.DataLabel.Select

sngPercente = CSng(Split(oPoint.DataLabel.Caption, "%")(0))

一切顺利。

答案 1 :(得分:0)

您的数据标签显示Y值,对吗?跳过数据标签并直接转到值。

Dim vYVals As Variant
Dim srs As Series
Dim iPt as Long
Dim dPctg As Double ' NO ADVANTAGE TO SINGLE OVER DOUBLE

Set srs = ActiveChart.SeriesCollection(1)
vYVals = srs.Values

For iPt = 1 to srs.Points.Count
  dPctg = vYVals(iPt)

  With srs.Points(iPt)
    Select Case dPctg
      Case 0
        .DataLabel.Caption = "OFF"
      Case < 0.7
        .Interior.Color = RGB(255, 0, 0)
      Case > 0.75
        .Interior.Color = RGB(0, 176, 80)
      Case Else
        .Interior.Color = RGB(148, 208, 80)
    End Select
  End With
Next