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

VBA提取系列集合值

1 个答案: