VBA 循环遍历所有图表中的所有系列
声明:本页面是StackOverFlow热门问题的中英对照翻译,遵循CC BY-SA 4.0协议,如果您需要使用它,必须同样遵循CC BY-SA许可,注明原文地址和作者信息,同时你必须将它归于原作者(不是我):StackOverFlow
原文地址: http://stackoverflow.com/questions/21165581/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
VBA looping through all series within all charts
提问by MagneTism
I'm having an issue with the looping through of several charts in my VBA code. I'm 99.7% sure that this is a really easy and quick fix but my brain isn't working today.
我在循环遍历 VBA 代码中的多个图表时遇到问题。我 99.7% 确信这是一个非常简单快捷的解决方法,但我的大脑今天无法正常工作。
I want the code to loop through every chart on the ActiveSheet, and for every data series that the chart contains I want it to add the last value of the series. In my example I have 9 charts, each with 3 series in them (bound to change, some have 2 but I digress).
我希望代码遍历 ActiveSheet 上的每个图表,并且对于图表包含的每个数据系列,我希望它添加该系列的最后一个值。在我的示例中,我有 9 个图表,每个图表有 3 个系列(一定会改变,有些有 2 个,但我离题了)。
I have the following code
我有以下代码
Sub AddLastValue()
Dim myChartObject As ChartObject
Dim myChart As Chart
Dim mySrs As Series
Dim myPts As Points
With ActiveSheet
For Each myChartObject In .ChartObjects
For Each myChart In .Chart
For Each mySrs In .SeriesCollection
Set myPts = .Points
myPts(myPts.Count).ApplyDataLabels Type:=xlShowValue
Next
Next
Next
End With
End Sub
If I remove the looping code and just do a
如果我删除循环代码并只做一个
Set myPts = ActiveSheet.ChartObjects(1).Chart. _
SeriesCollection(1).Points
myPts(myPts.Count).ApplyDataLabels type:=xlShowValue
Then it works for that specific chart and series, so I'm positive it is the looping that I'm messing up.
然后它适用于那个特定的图表和系列,所以我肯定这是我搞砸的循环。
Could someone tell me where I mess up the looping code?
有人能告诉我我在哪里弄乱了循环代码吗?
回答by Dmitry Pavliv
Try following code:
尝试以下代码:
Sub AddLastValue()
Dim myChartObject As ChartObject
Dim mySrs As Series
Dim myPts As Points
With ActiveSheet
For Each myChartObject In .ChartObjects
For Each mySrs In myChartObject.Chart.SeriesCollection
Set myPts = mySrs.Points
myPts(myPts.Count).ApplyDataLabels Type:=xlShowValue
Next
Next
End With
End Sub
回答by Andrzej Hymaniewicz
Not work for empty values.
不适用于空值。
This code find last not empty value and then adds label.
此代码查找最后一个非空值,然后添加标签。
For Each mySrs In myChartObject.Chart.SeriesCollection
Set myPts = mySrs.Points
Dim i As Integer
i = myPts.Count
Do Until i < 2 Or mySrs.Values(i) <> ""
i = i - 1
Loop
myPts(i).ApplyDataLabels Type:=xlShowValue
Next