Specific cell with 2 connectors, up and dow

[Doflamingo]

Hi all,

I try to find the lines of code that would allow me to put the right up connector to a cell

Here you can see what I have

https://www.dropbox.com/s/95uvji7ageuumy9/Connector flaw.png?dl=0

and what I would like

https://www.dropbox.com/s/c49g3t9v9xzlhf2/connector proper.png?dl=0

any idea how to make appear the connector between the line 8 and 9 ?

Here is the code

Private Sub CommandButton3_Click()
Dim orig As Range, dest As Range, con As Shape, up As Range, down As Range
'location of the LP
qty = WorksheetFunction.RoundUp((ListBox1.ListCount * 2 - 1) / 2, 0)
With Cells(10, qty + 2)
.ColumnWidth = 15
.Value = TextBox4.Value
.BorderAround
.HorizontalAlignment = xlCenter
.Borders.Weight = 3
End With

Set orig = Cells(10, qty + 2)
Set dest = Cells(15, qty + 2)
Set con = ActiveSheet.Shapes.AddConnector(1, orig.Left + orig.Width / 2, _
orig.Top + orig.Height, dest.Left + dest.Width / 2, dest.Top)
con.Line.Weight = 1
con.Line.ForeColor.RGB = RGB(0, 0, 0)
Set orig = orig.Offset(, 2)
Set dest = dest.Offset(, 2)

Set up = Cells(8, qty + 2)
Set down = Cells(9, qty + 2)
Set con = ActiveSheet.Shapes.AddConnector(1, orig.Left + orig.Width / 2, _
orig.Top + orig.Height, dest.Left + dest.Width / 2, dest.Top)
con.Line.Weight = 1
con.Line.ForeColor.RGB = RGB(0, 0, 0)
Set up = orig.Offset(, 2)
Set down = dest.Offset(, 2)

End Sub

the connector below the cell works perfectly, but not the connector above....

Any ideas

 

[Doflamingo]

Hi all,

Don't worry, I've found the solution by myself .

Just a matter of variables

 

[Doflamingo]

Here remains the big question of how to connect connectors by a single one

Here is the thread


[h=2]Linking connectors by a larger connector[/h]