我正在尝试循环显示一个条形图并使任何超过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
答案 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