SmartArt Hierarchy Node Limit? RRS feed

  • Question

  • Hoping someone has struggled with this before and can offer some advice.

    I need to dynamically display relational hierarchy and the method I decided to use is create a SmartArt object, then add nodes. I create an apex node, give it a text identifier (which resides in a shape in the Node object), then I pass the Child items I want to add into a procedure along with its Parent.

    The next step is adding standard shapes and connectors on top of the nodes and working within those shapes to perform some operations. I use SmartArt for its automatic formatting advantages. The reason I do the shapes is because SmartArt slows down Excel if too many nodes exist and because SmartArt nodes do not offer good formatting options.

    The problem I have is that there seems to be a maximum of nodes permitted on screen at one time.

    After adding about three hundred, each node I add causes another to simply vanish. The Node.Hidden property is set to msoTrue and can not be change as it is read-only. However, all nodes still exist within the SmartArt object.

    Can someone confirm that there's a hard limit on displayed nodes for Hierarchy graphs in SmartArt? Microsoft's page on the topic says it is unlimited.

    Here is the procedure I use if someone wants to dig in.

    Sub TestHierarchhy()
    Dim wbk As Workbook
    Dim sht As Worksheet
    Dim objNode As Office.SmartArtNode
    Dim objShape As Office.SmartArt
    Dim objShape2 As Excel.Shape
    Dim bolFound As Boolean
    Dim i As Integer
    Dim intLastNodeFound As Integer
    Set wbk = Application.Workbooks.Add
    wbk.Saved = True
    Set sht = wbk.Sheets(1)
    'create the smartart
    sht.Shapes.AddSmartArt Application.SmartArtLayouts(88)
    'ensure we are starting with just one node
    For Each objShape2 In sht.Shapes
         If objShape2.Type = msoSmartArt Then
              For Each objNode In objShape2.SmartArt.AllNodes
                   If objShape2.SmartArt.AllNodes.Count > 1 Then
                   End If
              Next objNode
         Set objNode = objShape2.SmartArt.Nodes(1)
         End If
    Next objShape2 
    'insert text into the only remaining node
    objNode.TextFrame2.TextRange.Text = "#1"
    'add 5 children to the top level node, creating level 2
    For i = 2 To 7
         Call AddChildren(sht, 1, i)
    Next i
    'next, randomly distribute nodes across the level 2 nodes
    'determine many nodes to distribute, this takes longer the more nodes you add, 400 takes ~5 minutes
    intNodecount = 400
    'to account for previous nodes, increment by 7
    intNodecount = intNodecount + 7
    Debug.Print Now
    For i = 8 To intNodecount
         'randomly get a parent
         RandomParent = 1
         Do Until RandomParent <> 1
              RandomParent = Int(7 * Rnd) + 1
         Call AddChildren(sht, RandomParent, i)
    Next i
    Debug.Print Now
    'you'll notice that the nodes still exist in the node object, but are not drawn
    End Sub
    Sub AddChildren(sht As Worksheet, ByVal strParent As String, ByVal strChild As String)
    Dim objParentNode As Office.SmartArtNode
    Dim objChildNode As Office.SmartArtNode
    Dim objNode As Office.SmartArtNode
    Dim objShape As Shape
    For Each objShape In sht.Shapes
         If objShape.Type = msoSmartArt Then
              For Each objNode In objShape.SmartArt.AllNodes
                   If objNode.TextFrame2.TextRange.Text = "#" & strParent Then
                   Set objParentNode = objNode
                   Exit For
                   End If
              Next objNode
         End If
    Set objNode = objParentNode.AddNode(
    If Not objNode Is Nothing Then
    objNode.TextFrame2.TextRange.Text = "#" & strChild
    End If
    End Sub

    Friday, September 7, 2018 6:18 PM