Excel VBA SmartArt Colours

DarrenRobinson

New Member
Joined
May 14, 2016
Messages
11
Hi all, I've managed to write some code that converts a list of people (with column headings: Name, Title, No of People, Manager) into a hierarchy SmartArt object. The code also formats each of the nodes (the forecolor, the box outline and the text color). The issue is that there are lines that connect the various boxes together which I would like to change from the standard Excel blue to black, but I can't find how to access these lines in VBA.

Any help would be greatly appreciated.

My second question is how do I get the the line below, in which I try to set the Type property of a SmartArt node to 2, to work.

Code:
'If Title = "Personal Assistant" Then iNode.Type = 2 'msoSmartArtNodeTypeAssistant


Code:
Sub OrgChart()
    
'Delete Previous Attempt
    Columns("E:Z").Delete


'Make Empty Chart
    Set oSALayout = Application.SmartArtLayouts(97) 'reference to organization chart
    Set oShp = ActiveWorkbook.ActiveSheet.Shapes.AddSmartArt(oSALayout)
    For x = 1 To 5: oShp.SmartArt.AllNodes(1).Delete: Next


'Find First One
    xRow = 2
    xCol = 1
    Do While Cells(xRow, xCol).Value <> ""
        If Cells(xRow, xCol + 3) = "" Then
            Name = Cells(xRow, xCol).Value
            Title = Cells(xRow, xCol + 1).Value
            Reports = Cells(xRow, xCol + 2).Value
        End If
        xRow = xRow + 1
    Loop


'Add First One to Chart (and colour it)
    Set TopNode = oShp.SmartArt.AllNodes.Add
    TopNode.TextFrame2.TextRange.Text = Title & " (" & Reports & ")" & Chr(10) & Name
    TopNode.Shapes(1).Fill.ForeColor.RGB = RGB(255, 255, 255)
    TopNode.Shapes(1).TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(0, 0, 0)
    TopNode.Shapes(1).Line.ForeColor.RGB = RGB(0, 0, 0)


'Add reports
    Call AddReports(Name, TopNode, oShp)


End Sub


Sub AddReports(ManagerName, ManagerNode, oShp)
'Find direct reports
    xRow = 2
    xCol = 1
    Do While Cells(xRow, xCol).Value <> ""
        If Cells(xRow, xCol + 3) = ManagerName Then
            Name = Cells(xRow, xCol).Value
            Title = Cells(xRow, xCol + 1).Value
            Reports = Cells(xRow, xCol + 2).Value
            Set iNode = ManagerNode.AddNode(msoSmartArtNodeBelow)                               'Create Node
            If Reports > 2 Then
                iNode.TextFrame2.TextRange.Text = Title & " (" & Reports & ")" & Chr(10) & Name  'Add title and name
            Else
                iNode.TextFrame2.TextRange.Text = Title & Chr(10) & Name                        'Add title and name
            End If
            iNode.Shapes(1).Fill.ForeColor.RGB = RGB(255, 255, 255)                             'Format
            iNode.Shapes(1).TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(0, 0, 0)
            iNode.Shapes(1).Line.ForeColor.RGB = RGB(0, 0, 0)
            'If Title = "Personal Assistant" Then iNode.Type = 2 'msoSmartArtNodeTypeAssistant
            Call AddReports(Name, iNode, oShp)                                                  'Add direct reports
        End If
        xRow = xRow + 1
    Loop


End Sub
 

Excel Facts

Highlight Duplicates
Home, Conditional Formatting, Highlight Cells, Duplicate records, OK to add pink formatting to any duplicates in selected range.
Hy Darren,<br>regarding your first question, you have to access the Shape.GroupItems property:<br><br>
Code:
<br>            With oShp.GroupItems(1).Line<br>                .Weight = 2<br>                .ForeColor.RGB = RGB(255, 0, 0)<br>                .Style = msoLineSingle<br>                .DashStyle = msoLineSolid<br>            End With<br>
<br><br><br>Regarding your second question, you cannot use the SmartArtNode.Type property since is read-only, you have to set an "assistant" while building the chart<br><br>
Code:
<br>            If Title <> "assistant" Then<br>                Set iNode = ManagerNode.AddNode(msoSmartArtNodeBelow, msoSmartArtNodeTypeDefault)<br>            Else<br>                Set iNode = ManagerNode.AddNode(msoSmartArtNodeDefault, msoSmartArtNodeTypeAssistant)<br>            End If<br>
<br><br>Regards,<br>Gigi
 
Upvote 0

Forum statistics

Threads
1,214,549
Messages
6,120,149
Members
448,948
Latest member
spamiki

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