Page 1 of 9 123 ... LastLast
Results 1 to 10 of 84

Thread: Add New Variable to Shapes

  1. #1
    Board Regular
    Join Date
    Apr 2019
    Posts
    227
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Add New Variable to Shapes

    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/vyik32v24d...%20BD.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/9p4pm5ukdm...hapes.png?dl=0

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

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

    Code:
    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
      
      For u = 1 To n
        If Tbl(u, 1) = parent And niv > 1 Then
          shapePère = Tbl(u, 2)
    
          forga.Shapes.AddConnector(msoConnectorElbow, 100, 100, 100, 100).Name = parent & "d"
    
          forga.Shapes(parent & "d").Line.ForeColor.SchemeColor = 22
          forga.Shapes(parent & "d").ConnectorFormat.BeginConnect forga.Shapes(shapePère), 3
          forga.Shapes(parent & "d").ConnectorFormat.EndConnect forga.Shapes(parent), 1
    
       End If
    
       If Tbl(u, 2) = parent Then créeShape Tbl(u, 1), niv + 1, Tbl(u, 3), f.Cells(u + 1, 1).Interior.Color
      Next u
      
      
    End Sub

    Any idea ?

  2. #2
    Board Regular Worf's Avatar
    Join Date
    Oct 2011
    Location
    Rio, Brazil
    Posts
    3,742
    Post Thanks / Like
    Mentioned
    8 Post(s)
    Tagged
    2 Thread(s)

    Default Re: Add New Variable to Shapes

    Hi

    Can you post the main code that calls the recursive procedure?
    Excel 2013 / Windows 8.1 (home)
    Excel 2013 / windows 7 (work)


  3. #3
    MrExcel MVP
    Join Date
    May 2003
    Location
    USA
    Posts
    4,699
    Post Thanks / Like
    Mentioned
    5 Post(s)
    Tagged
    1 Thread(s)

    Default Re: Add New Variable to Shapes

    And include where all these variables are declared.
    Jon Peltier
    Peltier Technical Services, Inc.
    Try Peltier Tech Charts for Excel

  4. #4
    Board Regular
    Join Date
    Apr 2019
    Posts
    227
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Add New Variable to Shapes

    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

  5. #5
    Board Regular
    Join Date
    Apr 2019
    Posts
    227
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Add New Variable to Shapes

    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 ?

  6. #6
    Board Regular Worf's Avatar
    Join Date
    Oct 2011
    Location
    Rio, Brazil
    Posts
    3,742
    Post Thanks / Like
    Mentioned
    8 Post(s)
    Tagged
    2 Thread(s)

    Default Re: Add New Variable to Shapes

    Placing the new information below the shapes will compete with the connectors. Would you prefer to put it on top of each shape?
    Excel 2013 / Windows 8.1 (home)
    Excel 2013 / windows 7 (work)


  7. #7
    Board Regular
    Join Date
    Apr 2019
    Posts
    227
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Add New Variable to Shapes

    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 ?

  8. #8
    Board Regular
    Join Date
    Apr 2019
    Posts
    227
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Add New Variable to Shapes

    Sorry I meant @Worf

  9. #9
    Board Regular Worf's Avatar
    Join Date
    Oct 2011
    Location
    Rio, Brazil
    Posts
    3,742
    Post Thanks / Like
    Mentioned
    8 Post(s)
    Tagged
    2 Thread(s)

    Default Re: Add New Variable to Shapes

    I increased the length of the vertical connectors:



    Code:
    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
    Excel 2013 / Windows 8.1 (home)
    Excel 2013 / windows 7 (work)


  10. #10
    Board Regular
    Join Date
    Apr 2019
    Posts
    227
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Add New Variable to Shapes

    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

    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 Â…

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •