将连接器链接到 ChartPoint VBA

Question

我创建了一个宏，如果该点的值小于 1 且不同于 0，则向 chartPoint 添加一个箭头
该代码运行良好，但是当我尝试创建箭头时，我收到一个错误“需要对象”并且我没有设法选择该形状的头部并在那里创建箭头。

下面的图片描述了我正在尝试做的事情

验证结果和添加箭头的代码如下

Sub fzerfgsdf()
 '
 '    fzerfgsdf Macro
 '

Dim clLeft As Double
Dim clTop As Double
Dim clWidth As Double
Dim clHeight As Double

Dim cl As Range
Dim shpOval As Shape

ActiveSheet.ChartObjects("Graphique 69").Activate
x = ActiveChart.SeriesCollection(1).Values
For i = LBound(x) To UBound(x)
  Debug.Print "Point "; i; "="; x(i)
  If x(i) < 1 And x(i) <> 0 Then
    ActiveChart.SeriesCollection(1).Points(i).Select


    Set cl = ActiveChart.SeriesCollection(1).Points(i).Select  '<-- Range("C2")

    clLeft = cl.Left
    clTop = cl.Top
    clHeight = 131.25
    clWidth = 579

    Set shpOval = ActiveSheet.Shapes.AddConnector(msoConnectorStraight, clLeft, clTop, 579, 131.25)
    shpOval.Select
    selection.ShapeRange.Line.EndArrowheadStyle = msoArrowheadOpen
    selection.ShapeRange.ShapeStyle = msoLineStylePreset20
  End If
Next i
End Sub

我找到了第一个问题的解决方案，即创建形状，但我不知道如何在使用特定值的蓝色图表查看图像的正确位置找到该形状

Sub fzerfgsdf()
 '
' fzerfgsdf Macro
 '
ActiveSheet.ChartObjects("Graphique 69").Activate
 x = ActiveChart.SeriesCollection(1).Values
For i = LBound(x) To UBound(x)
Debug.Print "Point "; i; "="; x(i)
If x(i) < 1 And x(i) <> 0 Then
ActiveSheet.ChartObjects("Graphique 69").Activate
  ActiveChart.SeriesCollection(1).Points(i).Select
Dim clLeft As Double
Dim clTop As Double
Dim clWidth As Double
Dim clHeight As Double

Dim cl As Point
Dim shpOval As Shape

Set cl = ActiveChart.SeriesCollection(1).Points(i)  '<-- Range("C2")

clLeft = cl.Left
 clTop = cl.Top
 clHeight = 131.25
 clWidth = 579

  Set shpOval = ActiveSheet.Shapes.AddConnector(msoConnectorStraight, 
  clLeft, 
   clTop, 579, 131.25)
   shpOval.Select
   selection.ShapeRange.Line.EndArrowheadStyle = msoArrowheadOpen
  selection.ShapeRange.ShapeStyle = msoLineStylePreset20
  End If
 Next i
 End Sub

任何人都可以解决这个问题吗？

最好的问候 马球

Answer 1

Public Sub fzerfgsdf()
    '
    ' fzerfgsdf Macro
    '
    Dim ws As Excel.Worksheet
    Dim chrt As Excel.Chart
    Dim sries As Excel.Series
    Dim x As Variant
    Dim clLeft As Double, clTop As Double
    Dim clWidth As Double, clHeight As Double
    Dim clBeginX As Double, clBeginY As Double, clEndX As Double, clEndY As Double
    Dim cl As Excel.Point
    Dim shpOval As Excel.Shape
    Dim dl As Excel.DataLabel
    Dim i As Long

    clHeight = 30
    clWidth = 15

    Set ws = Application.ActiveSheet
    Set chrt = ws.ChartObjects("Graphique 69").Chart
    Set sries = chrt.SeriesCollection(1)
    x = sries.Values
    For i = LBound(x) To UBound(x)
        Debug.Print "Point "; i; "="; x(i)
        If (x(i) < 1) And (x(i) <> 0) Then
            Set cl = sries.Points(i)
            With chrt.ChartArea
                clBeginX = IIf(.Left + cl.Left - clWidth < 0, 0, .Left + cl.Left - clWidth)
                clBeginY = IIf(.Top + cl.Top - clHeight < 0, 0, .Top + cl.Top - clHeight)
                clEndX = .Left + cl.Left
                clEndY = .Top + cl.Top
            End With

            Set shpOval = ws.Shapes.AddConnector(msoConnectorStraight, clBeginX, clBeginY, clEndX, clEndY)
            shpOval.Line.EndArrowheadStyle = msoArrowheadOpen
            shpOval.ShapeStyle = msoLineStylePreset20

            cl.HasDataLabel = True
            sries.HasLeaderLines = False
            Set dl = cl.DataLabel
            With dl
                .Text = "RFT 93%=> 5P"
                .Position = xlLabelPositionAbove
                .Format.AutoShapeType = msoShapeRectangularCallout
                .Format.Line.Visible = msoFalse
                .Top = cl.Top - clHeight - .Height - 5
                .Left = cl.Left - clWidth - (.Width / 2)
                With .Format.TextFrame2.TextRange.Font
                    .Size = 12
                    .Fill.ForeColor.RGB = RGB(255, 0, 0)
                    .Bold = msoTrue
                End With
            End With
        End If
    Next

    Set shpOval = Nothing
    Set cl = Nothing
    Set sries = Nothing
    Set chrt = Nothing
    Set ws = Nothing
End Sub