在不使用.Activate的情况下循环遍历图表上的点

时间:2017-04-24 15:55:25

标签: excel vba excel-vba

我正在尝试循环显示一个条形图并使任何超过2的值变为红色。以下代码目前正在运行,但我想使用.Activate

Sub Works()

    Dim wbk As Workbook
    Dim ws As Worksheet
    Dim x As Integer

    Set wbk = ThisWorkbook
    Set ws = wbk.Worksheets(1)

    With ws
        .ChartObjects("Chart 1").Activate
        For x = 1 To ActiveChart.SeriesCollection(1).Points.Count
            If ActiveChart.SeriesCollection(1).Points(x).DataLabel.Caption > 2 Then
                'If above 2 make Red
                ActiveChart.SeriesCollection(1).Points(x).Format.Fill.ForeColor.RGB = RGB(255, 0, 0)
            Else
                'If below or equal to 2 make Blue
                ActiveChart.SeriesCollection(1).Points(x).Format.Fill.ForeColor.RGB = RGB(0, 0, 255)
            End If
        Next x
    End With
End Sub

这是我提出的解决方案但是当我尝试启动For循环时出现运行时438错误。我假设它只是一个语法错误但我无法弄清楚如何在没有.Activate的情况下做到这一点

Sub Fails()

    Dim wbk As Workbook
    Dim ws As Worksheet
    Dim x As Integer

    Set wbk = ThisWorkbook
    Set ws = wbk.Worksheets(1)

    With ws.ChartObjects("Chart 1")
        For x = 1 To .SeriesCollection(1).Points.Count
            If .SeriesCollection(1).Points(x).DataLabel.Caption > 2 Then
                'If above 2 make Red
                .SeriesCollection(1).Points(x).Format.Fill.ForeColor.RGB = RGB(255, 0, 0)
            Else
                'If below or equal to 2 make Blue
                .SeriesCollection(1).Points(x).Format.Fill.ForeColor.RGB = RGB(0, 0, 255)
            End If
        Next x
    End With
End Sub

2 个答案:

答案 0 :(得分:2)

如A.S.H.的评论所述,.Chart是实现这一目标的方法。但是,您也可以将图表声明为chartObject,并使用With myChart.chart来获取早期绑定的奖励。

Option Explicit

Sub Fails()

    Dim ws          As Worksheet
    Dim myChart     As ChartObject
    Dim x           As Long

    Set ws = ThisWorkbook.Worksheets(1)
    Set myChart = ws.ChartObjects("Chart 2")

    With myChart.chart

        For x = 1 To .SeriesCollection(1).Points.Count
            'I have changed a bit the line below, as far as I could not achieve what were you doing...---v
            If CLng(.SeriesCollection(1).Name) > 2 Then
                .SeriesCollection(1).Points(x).Format.Fill.ForeColor.RGB = RGB(255, 0, 0)
            Else
                .SeriesCollection(1).Points(x).Format.Fill.ForeColor.RGB = RGB(0, 0, 255)
            End If
        Next x
    End With

End Sub

答案 1 :(得分:2)

@ A.S.H已在您的帖子的评论中向您描述了您的错误的原因。Series属于ChartObject.Chart而非ChartObject的属性。

尝试下面的代码,您可以利用VBA的图表功能来定义以下类型的变量:

Dim ChtObj As ChartObject
Dim Ser As Series
Dim SerPoint As Point

<强>代码

Option Explicit

Sub Fails()

    Dim wbk As Workbook
    Dim ws As Worksheet
    Dim ChtObj As ChartObject
    Dim Ser As Series
    Dim SerPoint As Point

    Set wbk = ThisWorkbook
    Set ws = wbk.Worksheets(1)
    Set ChtObj = ws.ChartObjects("Chart 1") '<-- set chart object

    With ChtObj
        Set Ser = .Chart.SeriesCollection(1)
        For Each SerPoint In Ser.Points
            If SerPoint.DataLabel.Caption > 2 Then 'If above 2 make Red
                SerPoint.Format.Fill.ForeColor.RGB = RGB(255, 0, 0)
            Else 'If below or equal to 2 make Blue
                SerPoint.Format.Fill.ForeColor.RGB = RGB(0, 0, 255)
            End If
        Next SerPoint
    End With

End Sub