取消选择标签和图表Excel VBA

时间:2014-08-15 13:06:06

标签: excel vba excel-vba charts

我使用“Sheet1”上的命令按钮使用VBA创建图表,但是图表正被添加到另一张图纸(“Sheet2”)。

添加图表后,我使用以下代码根据DataLabel值为条形图着色并更改DataLabel:

Dim oPoint As Excel.Point
Dim sngPercente As Single

For Each oPoint In Worksheets("Sheet2").ChartObjects("Performance").Chart.SeriesCollection(1).Points
oPoint.DataLabel.Select

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

运行此代码并转到“Sheet2”后,我注意到图表及其中的最后一个数据标签仍然被选中。

Chart http://im84.gulfup.com/6WoE7k.png

如何取消/取消选择此图表?

这就是我的尝试:

Worksheets("Sheet2").Range("A1").Select

因为代码是从另一张表运行而不起作用。

ActiveChart.Deselect

根本不起作用。

从代码中删除oPoint.DataLabel.Select行。

不可能,因为没有它,代码将因运行时错误而失败。

SendKeys "{ESC}"

工作,但非常不可靠,就好像与其他宏一起使用它会破坏代码,这将导致“代码执行被中断”错误。

我还能尝试其他什么吗?

2 个答案:

答案 0 :(得分:3)

我通过阅读值而不是字幕来完全避免这个问题:

Dim ChartRng                    As Range
Dim ser                         As Excel.Series
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
    Set ser = .SeriesCollection(1)
    ser.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)
    ser.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
    ser.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
With ser
    For n = 1 To .Points.Count
        Set oPoint = .Points(n)
        sngPercente = .Values(n) * 100

        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 n
End With

答案 1 :(得分:-1)

这里有一个小小的不一致

Worksheets("Sheet2").Range("A1").Select

我注意到在您的代码中,工作表被命名为“Sheet 2”并带有空格。您是否尝试在不存在的工作表中选择单元格?