Thanks Thanks:  0
Likes Likes:  0
Page 1 of 2 12 LastLast
Results 1 to 10 of 18

Thread: Using VBA for Smart Art

  1. #1
    Board Regular
    Join Date
    Mar 2011
    Posts
    130
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Using VBA for Smart Art

    Hi Folks,

    I am trying to use smart art to dynamically generate org charts based on some cell data. Unfortunately there is not that much on this online. Here is what I have so far:

    Code:
    Dim oSALayout As SmartArtLayout
    Set oSALayout = Application.SmartArtLayouts(92) 'Get a reference to the "heirarchy" smartart form.
    
    'Create a smartart shape
    Set oShp = ActiveWorkbook.ActiveSheet.Shapes.AddSmartArt(oSALayout)
    
    For i = 1 To 5 'clears all the default excel shapes
    oShp.SmartArt.AllNodes(1).Delete
    Next
    
    
    For i = 1 To 22
    oShp.SmartArt.AllNodes.Add
    oShp.SmartArt.AllNodes(i).TextFrame2.TextRange.Text = " " & Range("D" & i).Value
    Next
    The individual names are on the current sheet in column D and the level that they should be in the heirarchy is in column A. For some reason, the code as I have it creates the correct number of nodes in the tree, but it only copies about 1/5 of the names and leaves the rest of the cells blank.

    Also, I am not sure how to change the level of the nodes to match what it needs to be. I tried to add
    Code:
    oShp.smartart.allnodes(i).Level= x
    and
    Code:
    oShp.smartart.allnodes(i).Promote
    or
    Code:
    .Demote
    but I am getting error messages.

    Any ideas?

  2. #2
    Board Regular
    Join Date
    Mar 2011
    Posts
    130
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Using VBA for Smart Art

    I was able to get the text to fill in correctly, however I am still struggling with getting the levels correct. Right now I had the code take everything to "level 1" so it all looks like it flat horizontal line. Then I am trying the following:

    Code:
    For x = 2 To Num
    oShp.SmartArt.AllNodes(x - 1).TextFrame2.TextRange.Text = Cells(x, 4).Text
    Next
    For x = 1 To Num - 1
    q = Cells(x + 1, 1).Value
    On Error Resume Next
    
        Do
        oShp.SmartArt.AllNodes(x).Demote
        Loop Until oShp.SmartArt.AllNodes(x - 1).Level = q
    
    Next
    End Sub
    To no avail, unfortunately.

  3. #3
    New Member
    Join Date
    Jul 2011
    Posts
    2
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Using VBA for Smart Art

    Hi ilya2004

    I do have similar kind of requirement in our excel model, I tried to use your code and got "user-defined type not defined" compile error: am i doing anything wrong?


    thanks,
    Vdonthi.

  4. #4
    Board Regular
    Join Date
    Mar 2011
    Posts
    130
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Using VBA for Smart Art

    I never did get this to work. Maybe now that you have brought it up again, maybe someone will have an idea.

  5. #5
    New Member
    Join Date
    Jul 2011
    Posts
    2
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Using VBA for Smart Art

    Thanks for quick response

    I am getting error on first line when declaring dim of "SmartArtLayout" object in Excel 2007. I hope you have pass through this.

    Thanks,

  6. #6
    New Member
    Join Date
    Nov 2011
    Posts
    2
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Using VBA for Smart Art

    Hello ilya2004
    I have exactly the same problem as you. I tried almost everything,but no results. You wrote, that you've got a code putting everything to "level 1". Could you share a code, please?

    Thanks

  7. #7
    New Member
    Join Date
    Nov 2011
    Posts
    2
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Using VBA for Smart Art

    I got this work finally. With using recursion it was quite easy. There is my solution in Excel 2010(in 2007 doesn't work):
    Example of my input data:
    H00;USCR;48513687;Ústavní soud;PESPER01 060920110853;Org
    A00;USCR00O0A02J;USCR00O0A02J;0;00;Ústavní soud;
    A00;USCR00O0A03E;USCR00O0A02J;1;01;Justice;
    A00;USCR00O0A049;USCR00O0A02J;2;02;Generální sekretář;
    A00;USCR00O0A054;USCR00O0A02J;3;03;Soudní správa;
    A00;USCR00O0A06Z;USCR00O0A03E;1;01;1. senát;
    A00;USCR00O0A07U;USCR00O0A03E;2;02;2. senát;
    A00;USCR00O0A08P;USCR00O0A03E;3;03;3. senát;
    A00;USCR00O0A09K;USCR00O0A03E;4;04;4. senát;
    A00;USCR00O0A0AF;USCR00O0A03E;5;05;Funkcionář;
    A00;USCR00O0A0Q7;USCR00O0A049;1;20;Generální sekretář;
    A00;USCR00O0A0SX;USCR00O0A049;2;30;Analytický odbor;

    semicolon represent next column in excel
    important is only second column (ID of current node), third column (ID of parent node) and the sixth (name)
    Those lines i put into Excel

    Code:
    'Source is current open worksheet, 'Source=ThisWorkbook.Sheets(name of the current list)
    Private Sub CreateDiagram(Source As Worksheet)
    
        Dim oSALayout As SmartArtLayout
        Dim QNode As SmartArtNode
        Dim QNodes As SmartArtNodes
        Dim Line As Integer
        Dim PID As String      'identification of parent node
        
        Set oSALayout = Application.SmartArtLayouts(92) 'reference to organization chart
        Set oShp = ActiveWorkbook.ActiveSheet.Shapes.AddSmartArt(oSALayout)
        
        Set QNodes = oShp.SmartArt.AllNodes
        For i = 1 To 5      'delete all included nodes
            oShp.SmartArt.AllNodes(1).Delete
        Next
        
        'looking for root(s)
        Line = 2
        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, 6)
                PID = Source.Cells(Line, 2)
                Source.Rows(Line).Delete
                Call AddChildNodes(QNode, Source, PID)
            Else
                Line = Line + 1
            End If
        Loop
    
    End Sub
    And there follows the recursive function:

    Code:
    Private Sub AddChildNodes(QNode As SmartArtNode, Source As Worksheet, PID As String)
        Dim Line As Integer
        Dim Found As Boolean
        Dim ParNode As SmartArtNode
        Dim CurPid As String 'ID of current parent node
        
        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, 6)
                CurPid = Source.Cells(Line, 2)
                If Not Found Then Found = True 'something was find
                Source.Rows(Line).Delete
                Call AddChildNodes(QNode, Source, CurPid)
                Set QNode = ParNode
            ElseIf Found Then    'it's sorted,so nothing else can be found
                Exit Do
            Else
                Line = Line + 1
            End If
        Loop
        
    End Sub
    Maybe it looks complicated,but it works. Hope this helps to someone.

  8. #8
    New Member
    Join Date
    Jul 2012
    Posts
    1
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Using VBA for Smart Art

    Digging up an old thread here but was anyone able to get this to work on Excel 2007?

    Been trying to do so for awhile now but haven't gotten any results

  9. #9
    New Member
    Join Date
    Aug 2012
    Posts
    1
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Using VBA for Smart Art

    Ahoj, and Jak se Mas!

    (I am guessing that I am talking to a Czech? Muj ceske i velmi spatny - mluvit anglicky?)

    So I am having trouble in that the recursion seems to crash when building child nodes onto nodes one level below the root - did you experience the same issue?

    Please advise, Prosim!

    Thank you and Dekuji!

    - Rob

    Quote Originally Posted by Rahzell View Post
    I got this work finally. With using recursion it was quite easy. There is my solution in Excel 2010(in 2007 doesn't work):
    Example of my input data:
    H00;USCR;48513687;Ústavní soud;PESPER01 060920110853;Org
    A00;USCR00O0A02J;USCR00O0A02J;0;00;Ústavní soud;
    A00;USCR00O0A03E;USCR00O0A02J;1;01;Justice;
    A00;USCR00O0A049;USCR00O0A02J;2;02;Generální sekretář;
    A00;USCR00O0A054;USCR00O0A02J;3;03;Soudní správa;
    A00;USCR00O0A06Z;USCR00O0A03E;1;01;1. senát;
    A00;USCR00O0A07U;USCR00O0A03E;2;02;2. senát;
    A00;USCR00O0A08P;USCR00O0A03E;3;03;3. senát;
    A00;USCR00O0A09K;USCR00O0A03E;4;04;4. senát;
    A00;USCR00O0A0AF;USCR00O0A03E;5;05;Funkcionář;
    A00;USCR00O0A0Q7;USCR00O0A049;1;20;Generální sekretář;
    A00;USCR00O0A0SX;USCR00O0A049;2;30;Analytický odbor;

    semicolon represent next column in excel
    important is only second column (ID of current node), third column (ID of parent node) and the sixth (name)
    Those lines i put into Excel

    Code:
    'Source is current open worksheet, 'Source=ThisWorkbook.Sheets(name of the current list)
    Private Sub CreateDiagram(Source As Worksheet)
    
        Dim oSALayout As SmartArtLayout
        Dim QNode As SmartArtNode
        Dim QNodes As SmartArtNodes
        Dim Line As Integer
        Dim PID As String      'identification of parent node
        
        Set oSALayout = Application.SmartArtLayouts(92) 'reference to organization chart
        Set oShp = ActiveWorkbook.ActiveSheet.Shapes.AddSmartArt(oSALayout)
        
        Set QNodes = oShp.SmartArt.AllNodes
        For i = 1 To 5      'delete all included nodes
            oShp.SmartArt.AllNodes(1).Delete
        Next
        
        'looking for root(s)
        Line = 2
        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, 6)
                PID = Source.Cells(Line, 2)
                Source.Rows(Line).Delete
                Call AddChildNodes(QNode, Source, PID)
            Else
                Line = Line + 1
            End If
        Loop
    
    End Sub
    And there follows the recursive function:

    Code:
    Private Sub AddChildNodes(QNode As SmartArtNode, Source As Worksheet, PID As String)
        Dim Line As Integer
        Dim Found As Boolean
        Dim ParNode As SmartArtNode
        Dim CurPid As String 'ID of current parent node
        
        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, 6)
                CurPid = Source.Cells(Line, 2)
                If Not Found Then Found = True 'something was find
                Source.Rows(Line).Delete
                Call AddChildNodes(QNode, Source, CurPid)
                Set QNode = ParNode
            ElseIf Found Then    'it's sorted,so nothing else can be found
                Exit Do
            Else
                Line = Line + 1
            End If
        Loop
        
    End Sub
    Maybe it looks complicated,but it works. Hope this helps to someone.

  10. #10
    New Member
    Join Date
    Aug 2015
    Posts
    1
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Thumbs up Re: Using VBA for Smart Art

    Great post been searching for days on end and could not find a free solution that works as this one.

Some videos you may like

User Tag List

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
  •