Smart Art Org Chart

[Stefan_Sand]

Hello,

i adopted the Org Chart Maker you helped me with. First, you can build a WBS structure, group or ungroup it, as you wish. Now it is easy to color each chart shape with cell colors in column C or color the font (make it bold, underline and so on - only font size i did not adopt). Today i got an Excel sheet with maybe some new Smart Art styles. I wonder, how it is possible to make this as a structure base, so that it is possible to even show two (or more?) projects (or ORG structures) together - please see the Smart Art Chart(s) in table Goal SmartArt. - Now, this is only possible with making WBS structures (table WBS Maker).
How can these chart(s) be set to the VBA code line instead of: SmartArtLayouts("urn:microsoft.com/office/officeart/2005/8/layout/orgChart1") ?
Is there any possibillity?

[HansV]

You can find out the ID of a SmartArt object by selecting it, then typing (or copying/pasting) the following in the Immediate window and pressing Enter:

? selection.shaperange.item(1).smartart.layout.id

The one at the top of the Goal SmartArt sheet has ID:

urn:microsoft.com/office/officeart/2005/8/layout/orgChart1

just like the one on the OrgMusterASAP (2) sheet. The only difference is that the rectangles in this one have a gradient fill color instead of a single solid color.

The one at the bottom of the Goal SmartArt sheet has ID:

urn:microsoft.com/office/officeart/2005/8/layout/pictureOrgChart+Icon

[Stefan_Sand]

ok, that is cool.
If i have , for example in column G (the WBS code):
1
1.1
2
2.1
the code only shows 1 and 1.1 as a structure, not the structures under the two nodes 1 and 2 - i wonder how to do this if the Smart Art is the same as you wrote.

[HansV]

I don't see such an example in the workbook...

[Stefan_Sand]

ok, i put some example lines into it, to get a structure like in the Goal SmartArt table.
you can see, that the structure ends with 1.6.4 the node 2 with the underneath structure will not be shown. The goal should be, that more than one highest node can be shown(like the example in Goal SmartArt)

[HansV]

Here you go. AddChildren remains the same.

Code: Select all

Sub org()
'
' org Macro
' Macro to generate organization chart
'
'
    Dim shp As Shape
    Dim ogSALayout As SmartArtLayout
    Dim ogShp As Shape
    Dim QNodes As SmartArtNodes
    Dim QNode As SmartArtNode
    Dim t As Long
    Dim i As Long
    Dim Code As String
    Dim r As Long

    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    Application.EnableEvents = False

    For Each shp In ActiveSheet.Shapes
        If shp.Type = msoSmartArt Then
            shp.Delete
        End If
    Next shp

    Set ogSALayout = Application.SmartArtLayouts("urn:microsoft.com/office/officeart/2005/8/layout/orgChart1")
    Set ogShp = ActiveSheet.Shapes.AddSmartArt(ogSALayout, 630, 36, 720, 630)
    Set QNodes = ogShp.SmartArt.AllNodes
    t = QNodes.Count

    ' Delete all nodes except one
    For i = 2 To t
        ogShp.SmartArt.Nodes(1).Delete
    Next i

    ' Set root node properties
    Set QNode = QNodes(1)
    With QNode.TextFrame2.TextRange
        .Text = Range("B1").Value
        .Font.Fill.ForeColor.RGB = vbBlack
        .Font.Size = 8
        .Font.Bold = True 'Style = "Fett"
    End With
    QNode.Shapes(1).Fill.ForeColor.RGB = Range("C1").Interior.Color
    Code = Range("G2").Value

    ' Recursively add children nodes
    Call AddChildren(QNode, Code)

    ' Add other root nodes
    For r = 2 To Range("A1").End(xlDown).Row
        If Len(Range("G" & r + 1).Value) = 1 Then
            Set QNode = QNode.AddNode(Position:=msoSmartArtNodeAfter)
            With QNode.TextFrame2.TextRange
                .Text = Range("B" & r).Value
                .Font.Fill.ForeColor.RGB = vbBlack
                .Font.Size = 8
                .Font.Bold = True 'Style = "Fett"
            End With
            QNode.Shapes(1).Fill.ForeColor.RGB = Range("C" & r).Interior.Color
            Code = Range("G" & r + 1).Value

            ' Recursively add children nodes
            Call AddChildren(QNode, Code)
        End If
    Next r

    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub

[Stefan_Sand]

so coooooool. So the difference was that you added possible other root nodes?
Thank you , Hans!!!

[HansV]

Yes - the "root" nodes are the top-level ones. The original code assumed, based on all examples that you had provided, that there would be only one such.
The child nodes are added using msoSmartArtNodeBelow. The "root" nodes are added using msoSmartArtNodeAfter, each after the previous "root" node.

[Stefan_Sand]

very nice work, Hans, so people now can build complex organisational structures like family trees or project/program organisations. -> Building a WBS Plan (the heart plan in project management), even show the status of a node within half a minute is so cool!!!!
THANK YOU!

[HansV]

You're welcome! Glad to have been able to help.