How to change the lenght of a connector ?

[Doflamingo]

Dear all,

Does anyone know how to adapt the lenght of a connector.

Here the present code allow to draw a connector for the above border of a current cell, but I would like it a little bit longer.

AddConnector(msoConnectorStraight, .Offset(, 1).Left, _
            .Top + .Height / 17, .Offset(, 2).Left, .Top + .Height / 17)

I would like the half of the previous cell + current cell + half of the next cell

Any idea

 

[DanteAmor]

Try this

Sub lineconect()
    l = (ActiveCell.Offset(0, -1).Left + ActiveCell.Left) / 2
    r = (ActiveCell.Offset(0, 1).Left + ActiveCell.Offset(0, 2).Left) / 2
    t = (ActiveCell.Top + ActiveCell.Offset(1, 0).Top) / 2
    Set con = ActiveSheet.Shapes.AddConnector(msoConnectorStraight, l, t, r, t)
        con.Line.Weight = 1
        con.Line.ForeColor.RGB = RGB(0, 0, 0)
End Sub

 

[Doflamingo]

Hello Dante,
Many thanks for your answer and you help once again

Indeed, it works, but it displays only for one connector.

My mistake, I should have put the whole code, here it is below, where I have all the horizontal connectors at the right height.

Dim k%, pi
For k = 0 To ListBox1.ListCount - 1
    With Cells(8, k * 2 + 3)
        If k < ListBox1.ListCount - 1 Then
Set pi = ActiveSheet.Shapes.AddConnector(msoConnectorStraight, l.Offset(, 1).Left, _
            t.Top + .Height / 17, r.Offset(, 2).Left, .Top + r.Height / 17)
            pi.line.Weight = 1
            pi.line.ForeColor.RGB = RGB(0, 0, 0)
        End If
    End With

I tried to adapt your code to mine, but it doesn’t work

For k = 0 To ListBox1.ListCount - 1
    With Cells(8, k * 2 + 3)
        If k < ListBox1.ListCount - 1 Then
       
    l = (ActiveCell.Offset(0, -1).Left + ActiveCell.Left) / 2
    r = (ActiveCell.Offset(0, 1).Left + ActiveCell.Offset(0, 2).Left) / 2
    t = (ActiveCell.Top + ActiveCell.Offset(1, 0).Top) / 2
Set pi = ActiveSheet.Shapes.AddConnector(msoConnectorStraight, l.Offset(, 1).Left, _
        t.Top + .Height / 17, r.Offset(, 2).Left, .Top + r.Height / 17)
        pi.line.Weight = 1
        pi.line.ForeColor.RGB = RGB(0, 0, 0)

Please note that .height/17 is the location of each connector

Any ideas ?

 

[Doflamingo]

My mistake, here my code

Dim k%, pi
For k = 0 To ListBox1.ListCount - 1
    With Cells(8, k * 2 + 3)
        If k < ListBox1.ListCount - 1 Then
Set pi = ActiveSheet.Shapes.AddConnector(msoConnectorStraight, .Offset(, 2).Left, _
            .Top + .Height / 17, .Offset(, 1).Left, .Top + .Height / 17)
            pi.line.Weight = 1
            pi.line.ForeColor.RGB = RGB(0, 0, 0)
        End If
    End With
next

And here when I tried to adapt the code of @Dante but does not work

Dim k%, pi
For k = 0 To ListBox1.ListCount - 1
    With Cells(8, k * 2 + 3)
        If k < ListBox1.ListCount - 1 Then
    l = (ActiveCell.Offset(0, -1).Left + ActiveCell.Left) / 2
    r = (ActiveCell.Offset(0, 1).Left + ActiveCell.Offset(0, 2).Left) / 2
    t = (ActiveCell.Top + ActiveCell.Offset(1, 0).Top) / 2
Set pi = ActiveSheet.Shapes.AddConnector(msoConnectorStraight, l.Offset(, 2).Left, t.Top + .Height / 17, r.Offset(, 1).Left, t.Height / 17)
pi.line.Weight = 1
        pi.line.ForeColor.RGB = RGB(0, 0, 0)
End If
End With
    


Next

 

[DanteAmor]

Try this

Dim k%, pi
For k = 0 To ListBox1.ListCount - 1
    With Cells(8, k * 2 + 3)
        If k < ListBox1.ListCount - 1 Then
    l = (ActiveCell.Offset(0, -1).Left + ActiveCell.Left) / 2
    r = (ActiveCell.Offset(0, 1).Left + ActiveCell.Offset(0, 2).Left) / 2
    t = (ActiveCell.Top + ActiveCell.Offset(1, 0).Top) / 2
Set pi = ActiveSheet.Shapes.AddConnector(msoConnectorStraight, l, t, r, t)
        pi.line.Weight = 1
        pi.line.ForeColor.RGB = RGB(0, 0, 0)
End If
End With
Next

Note: the variables l,r,t They are not an object in a cell, they only contain a numerical value.

This is the result when cell C3 is the active cell

 

[Doflamingo]

Hello @Dante, thanks for your prompt reply.

Many thanks for the explanation of your code, I applied it.

It gives me the right number of connectors but not at the exact location (line 17 instead of line 7)

Here see below:
https://www.dropbox.com/s/zzdtmu2cy1j7dmu/Untitled.png?dl=0
I would like a connector for each of the inactive cell between active cells, for instance here in the dropbox link, cell D7 (inactive) between cell C7 (active) and E7(active)

https://www.dropbox.com/s/plggcofbnh0va56/1.png?dl=0

Or Maybe, if it’s not possible to apply code to inactive cells, it would give for each active cell (right direction)
Half of current cell + next cell +half of the cell after the next cell

But for the last active cell it would be the inverse direction (direction left)
Half of current cell + next cell +half of the cell after the next cell

What do you think @Dante ?

Kind regards

Doflamingo

 

[DanteAmor]

Try this

    For j = Columns("D").Column To Columns("J").Column Step 2
        l = (Cells(8, j).Offset(0, -1).Left + Cells(8, j).Left) / 2
        r = (Cells(8, j).Offset(0, 1).Left + Cells(8, j).Offset(0, 2).Left) / 2
        t = Cells(8, j).Top
        Set pi = ActiveSheet.Shapes.AddConnector(msoConnectorStraight, l, t, r, t)
            pi.Line.Weight = 1
            pi.Line.ForeColor.RGB = RGB(0, 0, 0)
    Next

 

[Doflamingo]

Dear @Dante,

So many thanks for your help, it almost worked

I have adapted your code to mine, here below

Dim k, pi
For J = Columns("D").Column To Columns("j").Column Step 2
        l = (Cells(8, J).Offset(0, -1).Left + Cells(8, J).Left) / 2
        r = (Cells(8, J).Offset(0, 1).Left + Cells(8, J).Offset(0, 2).Left) / 2
        t = Cells(8, J).Top
            With Cells(8, k * 2 + 3)
If k < ListBox1.ListCount - 1 Then
Set pi = ActiveSheet.Shapes.AddConnector(msoConnectorStraight, l, t, r, t)
            pi.line.Weight = 1
            pi.line.ForeColor.RGB = RGB(0, 0, 0)
End If
End With
Next

It works perfectly when I have 5 items in the Listbox1, but does not work when I have more than 5 items given that the last connector stop at the column J, or also when I have less than 5 items, it give an additional unnecessary connector

Any idea how to adapt the line ?

For J = Columns("D").Column To Columns("j").Column Step 2

With the inactive cells between active cell represented by the items of the listbox1

If k < ListBox1.ListCount - 1 Then

Here the screenshot with 4 items of the listbox1
https://www.dropbox.com/s/accsxhijydpiyiq/4 items.png?dl=0
Here the screenshot with 6 items of the list box 1
https://www.dropbox.com/s/nwapu0mkkyb405j/5 or 6 items.png?dl=0

Thanks again for your help @Dante

Kind regards

Doflamingo

 

[Doflamingo]

Sorry, The previous links of Dropbox didn't work. I redownloaded them

Here the screenshot with 4 items of the listbox1
https://www.dropbox.com/s/t52cpm2qsoo1bxa/4 items.png?dl=0
Here the screenshot with 6 items of the list box 1
https://www.dropbox.com/s/lho3jxartct0liw/6%20iteems.png?dl=0

 

[DanteAmor]

This is the logic.
You start at "D" and finish a column before the last box.

For example.
If the last box is in K, then you end up in J.
Another example, the last box in M, you end up in L


Then

[COLOR=#333333] 
[/COLOR]col_last_box = [COLOR=#ff0000]columns("K").column[/COLOR] - 1[COLOR=#333333]
For j = Columns("D").Column To [/COLOR]col_last_box [COLOR=#333333] Step 2
[/COLOR]

Somewhere in your logic you must have the column where you put the last box, then that variable you pass to the variable col_last_box