Add New Variable to Shapes

D

Doflamingo

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

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
  
[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 ?
 
Sort by date Sort by votes
On the chart that goes from bottom to top

I add a new variable in the column E with the value ''O'', where the objective is to outline the big shape related in Red, exemple if the cell E2 or E15 have the value ''O'' the big shapes related to them are outlined in Red, else no outline

I found this

Code: 
   With Selection.ShapeRange.Line
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 0, 0)
        .Transparency = 0
    End With
[COLOR=#333333]

[/COLOR]

But I currently don't know how to locate those lines in the code you gave me for the chart that goes from bottom to top
 
Upvote 0

Excel Facts

Format cells as currency
Select range and press Ctrl+Shift+4 to format cells as currency. (Shift 4 is the $ sign).
On the same chart that goes from bottom to top

Here is the code for a macro to link by horizontal connectors 2 shapes that were not linked previously by the macro ''orga''

Code: 
[/COLOR]Sub liensSup()   
   Set forga = ActiveSheet
   Set f = ActiveSheet
   For Each s In forga.Shapes
    If Right(s.Name, 4) = "Lien" Then s.Delete
   Next
    Tbl = f.Range("j2:l" & f.[g65000].End(xlUp).Row).Value
   n = UBound(Tbl)
   For i = 1 To UBound(Tbl)
        shape1 = Tbl(i, 1)
        shape2 = Tbl(i, 2)
        If Tbl(i, 3) = "Fleche" Then
           forga.Shapes.AddConnector(msoConnectorStraight, 100, 100, 100, 100).Name = shape1 & shape2 & "Lien"
           forga.Shapes(shape1 & shape2 & "Lien").Line.BeginArrowheadStyle = msoArrowheadTriangle
           forga.Shapes(shape1 & shape2 & "Lien").Line.EndArrowheadStyle = msoArrowheadTriangle
        Else
           forga.Shapes.AddConnector(msoConnectorElbow, 100, 100, 100, 100).Name = shape1 & shape2 & "Lien"
           forga.Shapes(shape1 & shape2 & "Lien").Line.ForeColor.SchemeColor = 22
        End If
        forga.Shapes(shape1 & shape2 & "Lien").ConnectorFormat.BeginConnect forga.Shapes(shape1), 4
        forga.Shapes(shape1 & shape2 & "Lien").ConnectorFormat.EndConnect forga.Shapes(shape2), 2
        forga.Shapes(shape1 & shape2 & "Lien").Line.DashStyle = msoLineDash
    Next i
End Sub






[COLOR=#333333]

There are two types of connectors and it only work if the shapes already exist. They are located in the column J and K that represent the shape 1 and Shape 2 and in the column L it represent the horizontal connector between shape 1 and shape 2

So what I try to do is for the macro orga that create the chart from bottom to top, I add 3 new variables from column F, G and H.

For instance in the column F, if cell F2 and cell F8 they have the values ''C'' into them, I would like the connectors be black and dotted

Code for VBA

Code: 
[/COLOR]Selection.ShapeRange.ShapeStyle = msoLineStylePreset25[COLOR=#333333]

For instance in the column G, if cell G2 and cell G8 they have the values ''S'' into them, I would like the connectors be just black

and finally For instance in the column H, if cell H2 and cell H8 they have the values ''C-S'' into them, I would like the connectors be orange and dotted

VBA code

Code: 
Selection.ShapeRange.ShapeStyle = msoLineStylePreset24

I try to adapt it to the code ''orga'' you kindly gave me with those new variables and inspire me with the code to link 2 shapes above to find the right solution... if you have any idea or suggestion ... I would happily take it

Many thanks for what you have done so far to help me

Kind regards


 
Upvote 0
This version uses a single worksheet, with the table starting at cell A1. As the code works by deleting rows, ranges are being moved around.

Code: 
Sub main()  ' run me
Dim arr(), i%
arr = Range([a1].CurrentRegion.Address)                 ' save original table
[ca:ce].ClearContents
Adjust
CreateDiagram ActiveSheet
[a:o].ClearContents
[a1].Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr ' original table
On Error Resume Next
For i = 1 To ActiveSheet.Shapes.Count
    If ActiveSheet.Shapes(i).TopLeftCell = [a1] Then ActiveSheet.Shapes(i).Delete
Next
On Error GoTo 0
End Sub


Sub Adjust()
Dim lr%, i%
For i = 1 To ActiveSheet.Shapes.Count
    ActiveSheet.Shapes(1).Delete
Next
[k:ad].ClearContents
lr = Range("a" & Rows.Count).End(xlUp).Row
[k1] = "Seq": [L1] = "code1": [m1] = "code2"
[L2] = [b2]: [n1] = "info": [o1] = "info2"
[m2] = [b2]: [k2] = 2: [n2] = 0.01
[o2] = "desc0"
Range("a2:a" & lr).Copy [L3]
Range("b2:b" & lr).Copy [m3]
Range("c2:c" & lr).Copy [o3]
Range("d2:d" & lr).Copy [n3]
Range("k3:k" & lr + 1).Formula = "=row()"
[a:d].ClearContents
[k1].CurrentRegion.Copy [a1]                    ' adjusted table
[L2].Interior.Color = RGB(35, 70, 90)
[k1].CurrentRegion.Copy [z100]
End Sub


Sub CreateDiagram(Source As Worksheet)
Dim oSALayout As SmartArtLayout, QNode As SmartArtNode, QNodes As SmartArtNodes, oshp As Shape, Line%, _
i%, r As Range, PID$, mn, mx, ws As Worksheet, crar(), c%, ad, v, t, s As ShapeRange, boss
c = 1
ReDim crar(1 To c)
Set ws = ActiveSheet
For i = 1 To ws.Shapes.Count
    ws.Shapes(1).Delete
Next
Set oSALayout = Application.SmartArtLayouts(89)
Set oshp = ws.Shapes.AddSmartArt(oSALayout)
oshp.Top = [a50].Top
Set QNodes = oshp.SmartArt.AllNodes
For i = 1 To 5
    oshp.SmartArt.AllNodes(1).Delete        ' initial nodes
Next
Line = 2                                     ' look for roots
boss = [b2]
Do While Source.Cells(Line, 1) <> ""
    If Source.Cells(Line, 2) = Source.Cells(Line, 3) Then
        Set QNode = oshp.SmartArt.AllNodes.Add
        QNode.TextFrame2.TextRange.Text = Source.Cells(Line, 2)
        PID = Source.Cells(Line, 2)         ' parent node
        Source.Rows(Line).Delete
        AddChildNodes QNode, Source, PID
    Else
        Line = Line + 1
    End If
Loop
oshp.SmartArt.AllNodes(1).TextFrame2.TextRange.Text = boss
oshp.Width = 1000
oshp.Height = 700
oshp.Select
CommandBars.ExecuteMso ("SmartArtConvertToShapes")
Selection.Ungroup
Set r = ws.[a2]
On Error Resume Next
For i = 1 To ws.Shapes.Count
    r = ws.Shapes(i).Height
    Set r = r.Offset(1)
Next
mn = WorksheetFunction.Min([a:a])
mx = WorksheetFunction.Max([a:a])
For i = ws.Shapes.Count To 1 Step -1
    If ws.Shapes(i).Height = mn Then ws.Shapes(i).Delete
    If ws.Shapes(i).Height = mx Then
        crar(c) = ws.Shapes(i).Name
        c = c + 1
        ReDim Preserve crar(1 To c)
    End If
Next
On Error GoTo 0
For i = LBound(crar) To UBound(crar)
    If Len(crar(i)) Then
        v = Split(ws.Shapes(crar(i)).TextFrame2.TextRange.Text, vbLf)(0)
        Set r = Range("aa:aa").Find(v, [aa1], xlValues, 1)
        ad = r.Offset(, 2)
        ws.Shapes(crar(i)).Fill.ForeColor.RGB = r.Interior.Color
        Set s = ws.Shapes.Range(Array(crar(i)))
        s.TextFrame2.TextRange.Font.Bold = msoTrue
        s.TextFrame2.TextRange.Font.Name = "+mj-lt"
        ws.Shapes.AddShape(62, 10, 10, ws.Shapes(crar(i)).Width / 2.5, ws.Shapes(crar(i)).Height / 3).Name = _
        ws.Shapes(crar(i)).Name & "aux"
        With ws.Shapes(ws.Shapes(crar(i)).Name & "aux")
            .Left = ws.Shapes(crar(i)).Left
            .Top = ws.Shapes(crar(i)).Top + ws.Shapes(crar(i)).Height + 2
            .Line.ForeColor.SchemeColor = 1
            .Fill.Visible = msoFalse
            .TextFrame.Characters.Text = FormatPercent(ad, 0, vbTrue, vbFalse, vbUseDefault)
            .TextFrame.Characters(1, Len(ad)).Font.Size = 9
            .TextFrame.Characters(1, Len(ad)).Font.ColorIndex = 0
            .TextFrame.Characters(1, Len(ad)).Font.Bold = 1
            If ad = 0 Then .TextFrame.Characters.Text = "0%"
        End With
    End If
Next
End Sub


Sub AddChildNodes(QNode As SmartArtNode, Source As Worksheet, PID$)
Dim Line%, Found As Boolean, ParNode As SmartArtNode, CurPid$, ad
Line = 2
Found = False                           'nothing found yet
Do While Source.Cells(Line, 1) <> ""
    If Source.Cells(Line, 3) = PID Then
        Set ParNode = QNode
        Set QNode = QNode.AddNode(msoSmartArtNodeBelow)
        QNode.TextFrame2.TextRange.Text = Cells(Line, 2) & vbLf & Cells(Line, 5)
        CurPid = Source.Cells(Line, 2)  ' current parent node
        If Not Found Then Found = True  'something was found
        Source.Rows(Line).Delete
        AddChildNodes QNode, Source, CurPid
        Set QNode = ParNode
        ElseIf Found Then               'it's sorted, nothing else can be found
        Exit Do
    Else
        Line = Line + 1
    End If
Loop
End Sub
 
Upvote 0
The chart that goes from bottom to top does not centre the offspring relative to its parent. Would you like to use the top to bottom template, which does the centring, or shall we continue with the current layout?

The result would be a centred bottom to top chart.
 
Last edited:
Upvote 0
Hello @Worf

Many thanks for your reply and your help on the topic, I have no more questions on the chart that goes from top to bottom.

About the chart that goes from bottom to top, is the top to bottom template will allow me to add the new variables in the column E, F, G and H about the color of connectors and outline of the shapes ? Because if not...I would prefer keep working on the current layout...
 
Upvote 0
The customizations you mention can probably be implemented on the top to bottom template, which at the end will become a bottom to top chart.
I will be back soon.
 
Upvote 0
Here is the bottom to top chart with the outline feature. As before, the table starts at cell A1.

gx4YI9C.png
 
Upvote 0
the code:

Code: 
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]Sub main()  ' run me
Dim arr(), i%, t
arr = Range([a1].CurrentRegion.Address)                 ' save original table
[ca:ce].ClearContents
Adjust
CreateDiagram ActiveSheet
[a:p].ClearContents
[a1].Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr ' original table
On Error Resume Next
For i = 1 To ActiveSheet.Shapes.Count
    If ActiveSheet.Shapes(i).TopLeftCell = [a1] Then ActiveSheet.Shapes(i).Delete
    t = ActiveSheet.Shapes(i).TextFrame2.TextRange.Text
    If Len(t) And Not t Like "*%*" Then ActiveSheet.Shapes(i).IncrementRotation 180
Next
On Error GoTo 0
End Sub

[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]Sub Adjust()
Dim lr%, i%
For i = 1 To ActiveSheet.Shapes.Count
    ActiveSheet.Shapes(1).Delete
Next
[k:ae].ClearContents
lr = Range("a" & Rows.Count).End(xlUp).Row
[k1] = "Seq": [L1] = "code1": [m1] = "code2"
[L2] = [b2]: [n1] = "info": [o1] = "info2": [p1] = "outline"
[m2] = [b2]: [k2] = 2: [n2] = 0.01: [o2] = "desc0"
Range("a2:a" & lr).Copy [L3]
Range("b2:b" & lr).Copy [m3]
Range("c2:c" & lr).Copy [o3]
Range("d2:d" & lr).Copy [n3]
Range("e2:e" & lr).Copy [p3]
Range("k3:k" & lr + 1).Formula = "=row()"
[a:e].ClearContents
[k1].CurrentRegion.Copy [a1]                    ' adjusted table
[L2].Interior.Color = RGB(35, 70, 90)
[k1].CurrentRegion.Copy [z100]
End Sub

[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]Sub CreateDiagram(Source As Worksheet)
Dim sal As SmartArtLayout, QNode As SmartArtNode, QNodes As SmartArtNodes, oshp As Shape, L%, _
i%, r As Range, PID$, mn, mx, ws As Worksheet, crar(), c%, ad, v, t, s As ShapeRange, boss
c = 1
ReDim crar(1 To c)
Set ws = ActiveSheet
For i = 1 To ws.Shapes.Count
    ws.Shapes(1).Delete
Next
Set sal = Application.SmartArtLayouts(89)
Set oshp = ws.Shapes.AddSmartArt(sal)
oshp.Top = [a50].Top
Set QNodes = oshp.SmartArt.AllNodes
For i = 1 To 5
    oshp.SmartArt.AllNodes(1).Delete        ' initial nodes
Next
L = 2                                     ' look for roots
boss = [b2]
Do While Source.Cells(L, 1) <> ""
    If Source.Cells(L, 2) = Source.Cells(L, 3) Then
        Set QNode = oshp.SmartArt.AllNodes.Add
        QNode.TextFrame2.TextRange.Text = Source.Cells(L, 2)
        PID = Source.Cells(L, 2)         ' parent node
        Source.Rows(L).Delete
        AddChildNodes QNode, Source, PID
    Else
        L = L + 1
    End If
Loop
oshp.SmartArt.AllNodes(1).TextFrame2.TextRange.Text = boss
oshp.Width = 1000
oshp.Height = 700
oshp.Select
CommandBars.ExecuteMso ("SmartArtConvertToShapes")
Selection.ShapeRange.IncrementRotation 180
Selection.Ungroup
Set r = ws.[a2]
On Error Resume Next
For i = 1 To ws.Shapes.Count
    r = ws.Shapes(i).Height
    Set r = r.Offset(1)
Next
mn = WorksheetFunction.Min([a:a])
mx = WorksheetFunction.Max([a:a])
For i = ws.Shapes.Count To 1 Step -1
    If ws.Shapes(i).Height = mn Then ws.Shapes(i).Delete
    If ws.Shapes(i).Height = mx Then
        crar(c) = ws.Shapes(i).Name
        c = c + 1
        ReDim Preserve crar(1 To c)
    End If
Next
On Error GoTo 0
For i = LBound(crar) To UBound(crar)
    If Len(crar(i)) Then
        v = Split(ws.Shapes(crar(i)).TextFrame2.TextRange.Text, vbLf)(0)
        Set r = Range("aa:aa").Find(v, [aa1], xlValues, 1)
        ad = r.Offset(, 2)
        ws.Shapes(crar(i)).Fill.ForeColor.RGB = r.Interior.Color
        Set s = ws.Shapes.Range(Array(crar(i)))
        s.TextFrame2.TextRange.Font.Bold = msoTrue
        s.TextFrame2.TextRange.Font.Name = "+mj-lt"
        If r.Offset(, 4) = "O" Then                 ' outline
            With s.Line
                .Weight = 4
                .Visible = msoTrue
                .ForeColor.RGB = RGB(200, 25, 55)
                .Transparency = 0.1
            End With
        End If
        ws.Shapes.AddShape(62, 10, 10, ws.Shapes(crar(i)).Width / 2.5, ws.Shapes(crar(i)).Height / 3).Name = _
        ws.Shapes(crar(i)).Name & "aux"
        With ws.Shapes(ws.Shapes(crar(i)).Name & "aux")
            .Left = ws.Shapes(crar(i)).Left
            .Top = ws.Shapes(crar(i)).Top + ws.Shapes(crar(i)).Height
            .Line.ForeColor.SchemeColor = 1
            .Line.Transparency = 1
            .Fill.Visible = msoFalse
            .TextFrame.Characters.Text = FormatPercent(ad, 0, vbTrue, vbFalse, vbUseDefault)
            .TextFrame.Characters(1, Len(ad)).Font.Size = 9
            .TextFrame.Characters(1, Len(ad)).Font.ColorIndex = 0
            .TextFrame.Characters(1, Len(ad)).Font.Bold = 1
            If ad = 0 Then .TextFrame.Characters.Text = "0%"
        End With
    End If
Next
End Sub[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]Sub AddChildNodes(QNode As SmartArtNode, Source As Worksheet, PID$)
Dim L%, Found As Boolean, ParNode As SmartArtNode, CurPid$, ad
L = 2
Found = False                           'nothing found yet
Do While Source.Cells(L, 1) <> ""
    If Source.Cells(L, 3) = PID Then
        Set ParNode = QNode
        Set QNode = QNode.AddNode(msoSmartArtNodeBelow)
        QNode.TextFrame2.TextRange.Text = Cells(L, 2) & vbLf & Cells(L, 5)
        CurPid = Source.Cells(L, 2)  ' current parent node
        If Not Found Then Found = True  'something was found
        Source.Rows(L).Delete
        AddChildNodes QNode, Source, CurPid
        Set QNode = ParNode
        ElseIf Found Then               'it's sorted, nothing else can be found
        Exit Do
    Else
        L = L + 1
    End If
Loop
End Sub
'*********************[/FONT]
 
Upvote 0
Hello @Worf

Many thanks for your reply on the chart

I really wanted to thank you personally and I send you a personnal message in your inbox

I just saw what you have done with smartart, and I had few questions

- Is it possible to increase by *1.5 the height of the connectors ?

I though it was that variable or this one
Code: 
L = 3

Code: 
oshp.Height = 700

but actually not, it is linked to the size of the shape

-Is it possible to keep the colors given to shapes in column A , because when the macro is launched, it erases the colors ...and at each time i have to give to each cell the colors they had before the macro was launched

-Is it possible to have no color and no data in the column AA to AE ? It seems the data from column A to E are exported to column AA to EE

Many thanks for your time and your help again

Kind regards
 
Upvote 0
Hi @Worf

I hope you are well :). I just wanted you to know i have found the solution to my previous questions:

-performed to have empty cells with no color in AA to EE
-Colors kept in the column AA

Just looking for the lines of code that would allow me to increase a little the height of the connectors


Kind regards
 
Upvote 0
You must log in or register to reply here.

Similar threads

D
  • Question Question
VBA add textbox to shapes
Replies
1
Views
2K
DanteAmor
DanteAmor
D
  • Question Question
Rearange structure chart for better display
Replies
0
Views
678
Doflamingo
D
D
  • Question Question
ConnectorElbow or arrow completely vertical or horizontal between 2 shapes
Replies
0
Views
1K
Doflamingo
D

Forum statistics

Threads
1,224,728
Messages
6,180,600
Members
452,989
Latest member
Ol Reliable

Share this page

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