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

提示:将鼠标放在中文语句上可以显示对应的英文。显示中英文
时间:2020-09-08 17:34:32  来源:igfitidea点击:

VBA looping through all series within all charts

excelvbaexcel-vbacharts

提问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