How to change the lenght of a connector ?

Doflamingo

Board Regular
Joined
Apr 16, 2019
Messages
238
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.

Code:
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 :confused:
 

Excel Facts

Excel motto
Not everything I do at work revolves around Excel. Only the fun parts.
Try this

Code:
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
 
Upvote 0
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.

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, 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 :(

Code:
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 ?
 
Upvote 0
My mistake, here my code

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

Code:
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
 
Upvote 0
Try this


Code:
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


2dccae2e8ff6225acfad86bbd2d97360.jpg
 
Upvote 0
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
 
Upvote 0
Try this


Code:
    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
 
Upvote 0
Dear @Dante,

So many thanks for your help, it almost worked :)

I have adapted your code to mine, here below

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 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 ?

Code:
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

Code:
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
 
Upvote 0
This is the logic.
You start at "D" and finish a column before the last box.

38ec7ceaee32a329da4a996a4e0cd54d.jpg


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

Code:
[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
 
Upvote 0

Forum statistics

Threads
1,224,823
Messages
6,181,181
Members
453,022
Latest member
Mohamed Magdi Tawfiq Emam

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top