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

 

[Doflamingo]

Hello @Dante,
First of all, many thanks again for your help and explanations.

Indeed, I understand that a connector has a begin and an end,

I just wanted to know if VBA could detect by itself the range ‘’K’’ and change that variable automatically taking into account the number of items in the listbox1, but following the logic, obviously it’s ‘’no’’.

That’s not so important given that I can manually remove the unnecessary connectors manually or add a new one with the code you gave me

Sub Sheet8_Button1_Click()
    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

Last question, how to put the connector at the bottom of the active cell and not at the middle of it like it does currently ?

Kind regards

Doflamingo

 

[Doflamingo]

Sorry, in my sentence, I meant

''I just wanted to know if VBA could detect by itself the range K and change that variable automatically taking into account the number of items in the listbox1, but following the logic, obviously it’s No. ''

 

[DanteAmor]

Sorry, in my sentence, I meant

''I just wanted to know if VBA could detect by itself the range K and change that variable automatically taking into account the number of items in the listbox1, but following the logic, obviously it’s No. ''

Yes you could, in your code you are using the number of items in the listbox, and creating boxes, then when you create your last box, there you have the variable with the last column.

How to put the connector at the bottom of the active cell and not at the middle of it like it does currently

At the top:

[COLOR=#333333]t = Cells(8, j).Top[/COLOR]

At the middle:

[COLOR=#333333]t = ([/COLOR][COLOR=#333333] Cells(8, j)[/COLOR][COLOR=#333333].Top + [/COLOR][COLOR=#333333] Cells(8, j)[/COLOR][COLOR=#333333].Offset(1, 0).Top) / 2[/COLOR]

At the bottom

[COLOR=#333333]t = Cells(8 + 1, j).Top[/COLOR]

 

[Doflamingo]

Dear @Dante, Thanks a lot for our explanations about the top, middle and bottom of a connector for an active cell, it works J.
To answer to your statement
Yes you could, in your code you are using the number of items in the listbox, and creating boxes, then when you create your last box, there you have the variable with the last column.

When I adapted the lines of code you gave me

Dim k, pi
col_last_box = Columns("K").Column - 1
        For J = Columns("D").Column To col_last_box 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

Those lines had the same result than the above code

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 makes appear either too much connectors or in the contrary not enough

 

[Doflamingo]

Actually those lines of code gave the exact number of connectors

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

I will try to adapt the variable l, t, r and t to the code above

Dim k, pi
col_last_box = Columns("K").Column - 1
For J = Columns("D").Column To col_last_box 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

 

[DanteAmor]

Then, it works?

 

[Doflamingo]

Hello @Dante

Currently no, it does not work…

I have adapted the variables l,t and r in red that gave me the right length of connectors in the code you gave me to the lines of code that gave me the right number of connectors

l = [COLOR=#ff0000](Cells(8, J).Offset(0, -1).Left + Cells(8, J).Left) / 2[/COLOR] = (.Offset(, 2).Left  + .left)/2

t = [COLOR=#ff0000]Cells(8, J).Top[/COLOR] = .Top + .Height / 15 

r = [COLOR=#ff0000](Cells(8, J).Offset(0, 1).Left + Cells(8, J).Offset(0, 2).Left) / 2[/COLOR] = .Offset(, 1).Left + .Offset(, 2).Left / 2

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 + .Left) / 2, _
            .Top + .Height / 15, .Offset(, 1).Left + (.Offset(, 1).Left + .Offset(, 2).Left) / 2, .Top + .Height / 15)
            pi.line.Weight = 1
            pi.line.ForeColor.RGB = RGB(255, 0, 0)
        End If
    End With
Next

It gives me the right number of connectors but not the right lenght … .

This time they are way too long…

 

[Doflamingo]

Almost done,

With that code, I have the right lenght of connectors and also the right number, but their location is 1 cell to far to the left

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(, -1).Left + .Left) / 2, _
            .Top + .Height / 15, (.Offset(, 1).Left + .Offset(, 2).Left) / 2, .Top + .Height / 15)
            pi.line.Weight = 1
            pi.line.ForeColor.RGB = RGB(255, 0, 0)
        End If
    End With
Next

Here the current display with the connectors in red
https://www.dropbox.com/s/dghfz9vpfe2vig1/final result.png?dl=0

I’ve just moved them a little bit to show you that I had the exact number and also the exact length (thanks to you), now I have to find a way to locate them at the exact location, it means currently they are 1,5 cell too far to the left, I have to move them 1,5 cell in the right direction…. Maybe with offset ?

Any ideas ?

 

[Doflamingo]

Dear @Dante,

Special thanks for your help, here is the final code, it works perfectly and the connectors have the right length and there is also the right numbers of connectors

Without your help, I wouldn't have found so quickly the solution

Here the 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(, 1).Left + .Left) / 2, _
            .Top + .Height / 15, (.Offset(, 2).Left + .Offset(, 3).Left) / 2, .Top + .Height / 15)
            pi.line.Weight = 1
            pi.line.ForeColor.RGB = RGB(0, 0, 0)
        End If
    End With
Next

The problem is solved

 

[DanteAmor]

Im glad to help you, thanks for the feedback.