Add New Variable to Shapes

[Doflamingo]

Hi all,

Here is the code to create a structure chart from range A to range C of the sheet ‘’BD’’

Here is a screenshot of the sheet ‘’BD’’
https://www.dropbox.com/s/vyik32v24dp2ysm/sheet BD.png?dl=0

There is the ‘’Big father‘’ in A2 which is the ‘’Boss’’

The column B states all the ‘’sub father’’ with their ‘’children’’ that are in the column A except for the value ‘’Boss’’

For example the ‘’Boss’’ in cell A2 is the father of ‘’Vice President’’ in cell A3 that is the father of ‘’Employee13’’ in cell A11

The column C of the sheet ‘’BD’’ is the description of what you see inside the shapes in the sheet ‘’Shapes’’ where the structure chart is displayed once the macro is activated

Here is a screenshot of the sheet ‘’Shapes’’ of what I have currently with the data of the sheet ''BD''

https://www.dropbox.com/s/9p4pm5ukdmyly8h/Sheet Shapes.png?dl=0

Here is the code I have to display the structure chart in the sheet ''Shapes''

Sub créeShape(parent, niv, Attribut, coul) ' procédure récursive
  hauteurshape = 48
  largeurshape = 85
  colonne = colonne + 1
  forga.Shapes.AddShape(msoShapeFlowchartAlternateProcess, 10, 10, largeurshape, hauteurshape).Name = parent
  forga.Shapes(parent).Line.ForeColor.SchemeColor = 1
  txt = parent & vbLf & Attribut
  With forga.Shapes(parent)
    .TextFrame.Characters.Text = txt
    .TextFrame.Characters(Start:=1, Length:=1000).Font.Size = 8
    .TextFrame.Characters(Start:=1, Length:=1000).Font.ColorIndex = 0
    .TextFrame.Characters(Start:=1, Length:=Len(parent)).Font.Bold = True
    .TextFrame.Characters(Start:=1, Length:=Len(parent)).Font.ColorIndex = 3
    .Fill.ForeColor.RGB = coul
  End With
  forga.Shapes(parent).Left = débutOrg.Left + inth * colonne
  forga.Shapes(parent).Top = débutOrg.Top + intv * (niv - 1)
  For i = 1 To n
    If Tbl(i, 1) = parent And niv > 1 Then
      shapePère = Tbl(i, 2)
      
      forga.Shapes.AddConnector(msoConnectorElbow, 100, 100, 100, 100).Name = parent & "c"
      
      forga.Shapes(parent & "c").Line.ForeColor.SchemeColor = 22
      forga.Shapes(parent & "c").ConnectorFormat.BeginConnect forga.Shapes(shapePère), 3
      forga.Shapes(parent & "c").ConnectorFormat.EndConnect forga.Shapes(parent), 1
      
   End If
   
   If Tbl(i, 2) = parent Then créeShape Tbl(i, 1), niv + 1, Tbl(i, 3), f.Cells(i + 1, 1).Interior.Color
  Next i
  
End Sub

My problem is that I would like to expand my variables, I add a new range of variable in the column D of the sheet ‘’BD’’ and I would like that the specific variable be not included in the shapes like the variable of the column C are, but rather be below and at the left of the shapes they are related to.

Here a screenshot of what I would like to obtain
https://www.dropbox.com/s/emm9bkqm9eanmfm/goal.png?dl=0

I have changes the code above with the red lines that represent the values of the column D but that does not work

Sub créeShape(parent, niv, Attribut, coul) ' procédure récursive
  hauteurshape = 48
  largeurshape = 85
  colonne = colonne + 1
  forga.Shapes.AddShape(msoShapeFlowchartAlternateProcess, 10, 10, largeurshape, hauteurshape).Name = parent
  forga.Shapes(parent).Line.ForeColor.SchemeColor = 1
  txt = parent & vbLf & Attribut
  With forga.Shapes(parent)
    .TextFrame.Characters.Text = txt
    .TextFrame.Characters(Start:=1, Length:=1000).Font.Size = 8
    .TextFrame.Characters(Start:=1, Length:=1000).Font.ColorIndex = 0
    .TextFrame.Characters(Start:=1, Length:=Len(parent)).Font.Bold = True
    .TextFrame.Characters(Start:=1, Length:=Len(parent)).Font.ColorIndex = 3
    .Fill.ForeColor.RGB = coul
  End With
  forga.Shapes(parent).Left = débutOrg.Left + inth * colonne
  forga.Shapes(parent).Top = débutOrg.Top + intv * (niv - 1)
  For i = 1 To n
    If Tbl(i, 1) = parent And niv > 1 Then
      shapePère = Tbl(i, 2)
      
      forga.Shapes.AddConnector(msoConnectorElbow, 100, 100, 100, 100).Name = parent & "c"
      
      forga.Shapes(parent & "c").Line.ForeColor.SchemeColor = 22
      forga.Shapes(parent & "c").ConnectorFormat.BeginConnect forga.Shapes(shapePère), 3
      forga.Shapes(parent & "c").ConnectorFormat.EndConnect forga.Shapes(parent), 1
      
   End If
   
   If Tbl(i, 2) = parent Then créeShape Tbl(i, 1), niv + 1, Tbl(i, 3), f.Cells(i + 1, 1).Interior.Color
  Next i
  
[COLOR=#ff0000]  For u = 1 To n[/COLOR]
[COLOR=#ff0000]    If Tbl(u, 1) = parent And niv > 1 Then[/COLOR]
[COLOR=#ff0000]      shapePère = Tbl(u, 2)[/COLOR]
[COLOR=#ff0000]      [/COLOR]
[COLOR=#ff0000]      forga.Shapes.AddConnector(msoConnectorElbow, 100, 100, 100, 100).Name = parent & "d"[/COLOR]
[COLOR=#ff0000]      [/COLOR]
[COLOR=#ff0000]      forga.Shapes(parent & "d").Line.ForeColor.SchemeColor = 22[/COLOR]
[COLOR=#ff0000]      forga.Shapes(parent & "d").ConnectorFormat.BeginConnect forga.Shapes(shapePère), 3[/COLOR]
[COLOR=#ff0000]      forga.Shapes(parent & "d").ConnectorFormat.EndConnect forga.Shapes(parent), 1[/COLOR]
[COLOR=#ff0000]      [/COLOR]
[COLOR=#ff0000]   End If[/COLOR]
[COLOR=#ff0000]   [/COLOR]
[COLOR=#ff0000]   If Tbl(u, 2) = parent Then créeShape Tbl(u, 1), niv + 1, Tbl(u, 3), f.Cells(u + 1, 1).Interior.Color[/COLOR]
[COLOR=#ff0000]  Next u[/COLOR]
  
  
End Sub

Any idea ?

 

[Worf]

Hi

Can you post the main code that calls the recursive procedure?

 

[Jon Peltier]

And include where all these variables are declared.

 

[Doflamingo]

Hi @Worf and @Jon Peltier
Here find the workbook, I've worked on it again so it may have changed a little bit

https://www.dropbox.com/s/ksum9881ck2ynx8/ok.xlsm?dl=0

 

[Doflamingo]

So as you can see, the variable in the column C are included into the shapes. That's what I want.

But I also would like that the variables of the column B be integrated, not into the shapes, but below at the left of each of them for each specific variable related to a specific shape.

Any idea ?

 

[Worf]

Placing the new information below the shapes will compete with the connectors. Would you prefer to put it on top of each shape?

 

[Doflamingo]

Hi @Worf, Many thanks for your reply

Ok I understand, so that's really not possible to place the variables of the column B below each specific related shapes ? Because it's going to compete with the location of the connector....

So I might think, is it possible to locate those variables be included into the shapes at their bottom - middle centre ?

 

[Doflamingo]

Sorry I meant @Worf

 

[Worf]

I increased the length of the vertical connectors:

Dim colonne%, débutOrg As Range, f As Worksheet, forga As Worksheet, inth%, intv%, Tbl()
Sub orga()
Dim s As Shape
'-------------------------------------niveau 0
Set f = Sheets("data1")
Set forga = Sheets("test1")
forga.Activate
Tbl = f.Range("a2:d" & f.[A65000].End(xlUp).Row).Value
For Each s In forga.Shapes
    If s.Type = 17 Or s.Type = 1 Then s.Delete
Next
MsgBox "Ready?"
inth = 70:   intv = 100:   colonne = 0
Set débutOrg = forga.[e20]
créeShape f.[p2], 1, f.[p3], f.[c2].Interior.Color, f.[d2]
End Sub


Sub créeShape(parent, niv, Attribut, coul, ad) ' procédure récursive
Dim hshape%, lshape%, i%, spere$
hshape = 48:  lshape = 85
colonne = colonne + 1
forga.Shapes.AddShape(62, 10, 10, lshape, hshape).Name = parent
forga.Shapes.AddShape(62, 10, 10, lshape / 3, hshape / 3).Name = parent & "aux"
With forga.Shapes(parent & "aux")
    .Line.ForeColor.SchemeColor = 1
    .Left = débutOrg.Left + inth * colonne
    .Fill.ForeColor.RGB = coul
    .Top = débutOrg.Top - intv * (niv - 1) + forga.Shapes(parent).Height + 5
    .TextFrame.Characters.Text = ad
    .TextFrame.Characters(1, Len(ad)).Font.Size = 8
    .TextFrame.Characters(1, Len(ad)).Font.ColorIndex = 0
    .TextFrame.Characters(1, Len(ad)).Font.Bold = 1
End With
With forga.Shapes(parent)
    .Line.ForeColor.SchemeColor = 1
    .TextFrame.Characters.Text = parent & vbLf & Attribut
    .TextFrame.Characters(Start:=1, Length:=1000).Font.Size = 8
    .TextFrame.Characters(Start:=1, Length:=1000).Font.ColorIndex = 0
    .TextFrame.Characters(Start:=1, Length:=Len(parent)).Font.Bold = True
    .TextFrame.Characters(Start:=1, Length:=Len(parent)).Font.ColorIndex = 3
    .Fill.ForeColor.RGB = coul
    .Left = débutOrg.Left + inth * colonne
    .Top = débutOrg.Top - intv * (niv - 1)
End With
For i = 1 To UBound(Tbl)
    If Tbl(i, 1) = parent And niv > 1 Then
        spere = Tbl(i, 2)
        forga.Shapes.AddConnector(msoConnectorElbow, 100, 100, 100, 100).Name = parent & "c"
        forga.Shapes(parent & "c").Line.ForeColor.SchemeColor = 22
        forga.Shapes(parent & "c").ConnectorFormat.BeginConnect forga.Shapes(spere), 1
        forga.Shapes(parent & "c").ConnectorFormat.EndConnect forga.Shapes(parent), 3
    End If
    If Tbl(i, 2) = parent Then créeShape Tbl(i, 1), niv + 1, Tbl(i, 3), coul, Tbl(i, 4)
Next
End Sub

 

[Doflamingo]

Hello @Worf

Many thanks for your reply, that’s perfect

The variables are exactly at the location wanted.

Indeed, that’s was the best idea to put them into new shapes. What I try now is to make those new little shapes representing the variables of the column D like with ‘’no fill’’ and ‘’no outline’’

With that line of code

Selection.ShapeRange.Fill.Visible = msoFalse

Just a question

I do not understand why when the values of the column D are represented in % , the variables represented in those little new shapes are written in numerical value

Example: cell D1 has the value 60% and the value written in the shape is written like 0.6 …