VBA提取系列集合值

Question

我有一张图表，想在两点之间画一个箭头。这两个点来自两个不同的系列，但具有相同的x值。

为了做到这一点，我觉得我必须知道绘图点的y值，以及y轴的最小和最大比例。由此，我应该能够绘制箭头。

我的问题是如何获得y值？我不想把它们从桌子上拿下来，因为我正在迭代许多图表。

我本以为我会做这样的事情：

Sub Tester()
Dim sht As Worksheet
Dim CurrentSheet As Worksheet
Dim cht As ChartObject
Dim PA_w, PA_h, PA_l, PA_t, min_x, min_y, max_x, max_y, _
x_node1, x_node2, y_node1, y_node2 As Double
Dim Npts, i As Integer
Dim s As Shape
Application.ScreenUpdating = False
Application.EnableEvents = False
Set CurrentSheet = ActiveSheet
For Each sht In ActiveWorkbook.Worksheets
    For Each cht In sht.ChartObjects
        cht.Activate
        For Each s In cht.Chart.Shapes
            If Not (s.Type = msoAutoShape) Then s.Delete
        Next s
        Set s1 = cht.Chart.SeriesCollection(3)
        Set s2 = cht.Chart.SeriesCollection(4)
        Npts = s1.Points.Count
        PA_w = cht.Chart.PlotArea.InsideWidth
        PA_h = cht.Chart.PlotArea.InsideHeight
        PA_l = cht.Chart.PlotArea.InsideLeft
        PA_t = cht.Chart.PlotArea.InsideTop
        max_x = cht.Chart.Axes(1).MaximumScale
        min_x = cht.Chart.Axes(1).MinimumScale
        max_y = cht.Chart.Axes(2).MaximumScale
        min_y = cht.Chart.Axes(2).MinimumScale
        For i = 0 To 4
            With cht.Chart.Shapes.AddLine(PA_l + i * PA_w / 4, PA_t, PA_l + i * PA_w / 4, 4 * PA_t + PA_h).Line
            .ForeColor.RGB = RGB(0, 0, 0)
        End With
    Next i
    With cht.Chart.Shapes
        .AddLine(PA_l, PA_t, PA_l + PA_w, PA_t).Line.ForeColor.RGB = RGB(0, 0, 0)
        .AddLine(PA_l, PA_t + PA_h, PA_l + PA_w, PA_t + PA_h).Line.ForeColor.RGB = RGB(0, 0, 0)
        End With
        For i = 1 To Npts
            x_node1 = PA_l + (s1.XValues(i) - min_x) * PA_w / (max_x - min_x)
            x_node2 = PA_l + (s2.XValues(i) - min_x) * PA_w / (max_x - min_x)
            y_node1 = PA_t + (max_y - s1.Values(i)) * PA_h / (max_y - min_y)
            y_node2 = PA_t + (max_y - s2.Values(i)) * PA_h / (max_y - min_y)
            Set myShape = cht.Shapes.AddLine(x_node1, y_node1, x_node2, y_node2)
            With myShape.Line
                .EndArrowheadLength = msoArrowheadLong
                .EndArrowheadWidth = msoArrowheadWidthMedium
                .EndArrowheadStyle = msoArrowheadTriangle
            End With
        Next i
    Next cht
Next sht
CurrentSheet.Activate
Application.EnableEvents = True
End Sub

我本以为这会奏效，但我只是得到了一个运行时和自动化错误：（该错误似乎是在最后的for循环中，由括号中的.Values和.XValues引用引起的。

Answer 1

您可以使用格式化为不显示和播放几何图形的数据标签或标记。

Sub c()
Dim c As Chart
Dim s As Series
Dim d As DataLabel
Set c = ActiveSheet.ChartObjects(1).Chart
Set s = c.SeriesCollection(2)
Set d = s.DataLabels(1)
Debug.Print d.Text, d.Top

End Sub