Link Connectors to ChartPoint VBA - excel

Question

I created a macro that add an arrow to chartPoint if value of that point is under 1 and different from 0
The code works perfectly but When Itry to create The Arrow I get an error "Object Required" and I didn't manage to select the head of that shape and create arrow there .
What I'm trying to do is described in the Image below
The code of Verifying Result and Add arrow is below
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
I found solution for first problem which is creating shape but I can't figure out how to locate that shape in the right place where the blue chart using a specific values see image
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
Could Anyone light in solving This ?
Best Regards
Polos

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