Linking connectors by a larger connector

[Doflamingo]

Hi all,

I'm trying to find the lines of code to link the little connectors to a single one.

Here is what I have currently, where the cells above represent the items b of a listbox 2, with a connector for each item, then below there is a cell that contain the value of a textbox.

Currently what I have with the condition that my list box 2 contains 5 items

https://www.dropbox.com/s/uvg353oywi...iddle.png?dl=0

and the goal is to find how to link connectors by a signe one and make appear a little one which would link the big one with the cells containing the text box value

https://www.dropbox.com/s/rby1bdc0u8...20for.png?dl=0

Here is the code of the listbox2 that allows me to displays all the items of the listbox 2 in the same row, with a connector for each item

Dim orig As Range, dest As Range, b%, con As Shape
For b = 0 To ListBox2.ListCount - 1
With Cells(5, b * 2 + 3)
.ColumnWidth = 15
.Value = ListBox2.List(b)
.BorderAround
.HorizontalAlignment = xlCenter
.Borders.Weight = 3
End With

Set orig = Cells(5, b * 2 + 3)
Set dest = Cells(12, b * 2 + 3)
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)

I think I should remove that line
Set dest = Cells(12, b * 2 + 3)
because it decides the lenght of the connectors

And here is the code of the cell containing the textbox value

qty = WorksheetFunction.RoundUp((ListBox2.ListCount * 2 - 1) / 2, 0)
With Cells(10, qty + 2)
.ColumnWidth = 15
.Value = TextBox1.Value
.BorderAround
.HorizontalAlignment = xlCenter
.Borders.Weight = 3
End With


Any ideas ?

 

[Doflamingo]

Dear all,

So sorry to relaunch you, but if anyone has an idea, I would be very grateful...I need this for my job

Any help would be extremely appreciable.

Regards

 

[Worf]

Hi

i will work on this as soon as possible...

 

[Doflamingo]

Thanks Worf for your answer and your help.

Kind regards

Doflamingo

 

[Worf]

The example below shows how to create an organizational chart entirely via code; do you think this technique can be applied to your case?

Sub OrgChart()
Dim lay As SmartArtLayout, sh As Shape, i%, ns As SmartArtNodes, _
new2 As SmartArtNode, a, ws As Worksheet, el As Shape, mymin, mymax
Set ws = ActiveSheet
a = Array("item1", "item2", "item3", "item4")
Set lay = Application.SmartArtLayouts(92)
Set sh = ws.Shapes.AddSmartArt(lay)
Set ns = sh.SmartArt.AllNodes
For i = ns.Count To 1 Step -1           ' leave only first level
    If ns(i).Level = 3 Or ns(i).Level = 2 Then ns(i).Delete
Next
ns(1).TextFrame2.TextRange.Text = "Boss"
For i = LBound(a) To UBound(a)          ' add second level
    Set new2 = ns(1).AddNode(msoSmartArtNodeBelow)
    new2.TextFrame2.TextRange.Text = a(UBound(a) - i)
Next
sh.Select
CommandBars.ExecuteMso ("SmartArtConvertToShapes")
Set sh = ws.Shapes(Selection.Name)
mymin = 1000
mymax = 0
For Each el In sh.GroupItems
    mymin = WorksheetFunction.Min(mymin, el.Height)
    mymax = WorksheetFunction.Max(mymax, el.Height)
Next
sh.IncrementRotation 180                ' rotate the whole thing
For Each el In sh.GroupItems            ' rotate text boxes
    If el.Height = mymax Then el.IncrementRotation 180
Next
End Sub

 

[Doflamingo]

Hello Worf, thanks a lot for your answer

Here see what the code you gave allows to display
https://www.dropbox.com/s/da060qbbf7anio8/Untitled.png?dl=0

And here what I would like, rather in the hierarchy smart art
https://www.dropbox.com/s/q76k13o0zat8dto/Hierarchy Smart Art.png?dl=0

Where for instance an item a holds item b, c and d

Is it possible to build a userform or a table to decide what items holds how many other items? To enter the item in a table or a userform and then it change the structure of the smart art, without considering the number of items held, that’s why a listbox was not a so bad idea …

I think the table would give this, just an example

Holder	items held
a	b
	c
	d

<tbody>
</tbody>

Choose the item	items held
b	e
	f

<tbody>
</tbody>

Imagine if the item b held 2 other items, e and f, it would give this
https://www.dropbox.com/s/83x0f2srhim91yf/bef.png?dl=0

Any ideas ?

But thank you again for your help on this matter

 

[Doflamingo]

Dear all,

I have almost found what I wanted, here find what the code allows to display

https://www.dropbox.com/s/3gkqqqh4120pt04/The project is going on.png?dl=0

Does anyone have an idea about how to connect the red connectors with the black ones ? That means the red ones have to be at the line between 7 and 8 and and a little bit longer than they are currently

Here is the code

Private Sub CommandButton2_Click()

Dim orig As Range, dest As Range, b%, con As Shape, s As Shape, ws As Worksheet


For b = 0 To ListBox1.ListCount - 1


With Cells(5, b * 2 + 3)
.ColumnWidth = 15
.Value = ListBox1.List(b)
.BorderAround
.HorizontalAlignment = xlCenter
.Borders.Weight = 3
End With

Set orig = Cells(5, b * 2 + 3)
Set dest = Cells(8, b * 2 + 3)
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)
Next



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

End sub ()

Any ideas ?

 

[Worf]

Take a look at this thread:

https://www.mrexcel.com/forum/excel-questions/554224-using-vba-smart-art.html