Click here to Skip to main content
Click here to Skip to main content

Tagged as

How to display direct and indirect counts for Subordinates in Visio Organization

, 23 Jan 2012 CPOL
Rate this:
Please Sign up or sign in to vote.
Visio Macro that displays the direct and indirect counts of subordinates in an Organization Chart.
I have seen a large number of posts related to this, but unfortunately I could not find an easy answer to being able to display counts in org charts for Visio. As a result, I coded (hacked may be a better term) the following macro for the desired functionality. Hopefully others will find it useful.
  • RecursiveCount - This is a recursive method that count subs uses and it does all the work.
  • CountSubs - This is the starting point. Select the top most node in your org chart, then run this macro.
  • SetCountsToBlank - This is a little helper macro that resets all the org shapes on your diagram to "".
  • MakeBoxesBigger - This is another little helper macro that runs through and re-sizes your shapes. I have used this when I get long names, etc. with moderate success. There may be better ways to do this within the orgchart stuff.
Function RecursiveCount(s As Shape) As String
    Dim count As Integer
    
    count = 0
    dc = s.FromConnects.count - 1
    
    For i = 1 To s.FromConnects.count
       If s.Text <> s.FromConnects(i).FromSheet.Connects(2).ToSheet.Text Then
            count = count + 1
            rc = RecursiveCount(s.FromConnects(i).FromSheet.Connects(2).ToSheet)
            count = count + rc
       End If
    Next
    If dc > 0 Then
        s.Shapes(4).Text = dc
        If (count > 0) And (count <> dc) Then
            s.Shapes(4).Text = s.Shapes(4).Text & "(" & count & ")"
        End If
    End If
    RecursiveCount = count
End Function
 
Sub CountSubs()
    ' select the top most node then run this macro
    Dim s As Shape
    Set s = ActiveWindow.Selection(1)
    
    ' now recursively update counts
    i = RecursiveCount(s)
    
End Sub
 
Sub SetCountsToBlank()
Dim s As Shape
For Each s In ActivePage.Shapes
        If s.Shapes.count >= 4 Then
            s.Shapes(3).Text = ""
            s.Shapes(4).Text = ""
    
        End If
    Next
End Sub
 
Sub MakeBoxesBigger()
Dim s As Shape
For Each s In ActivePage.Shapes
    If (s.Type = 2) Then
        s.CellsSRC(visSectionObject, visRowXFormOut, visXFormWidth).FormulaU = "1.37 in"
        s.CellsSRC(visSectionObject, visRowXFormOut, visXFormHeight).FormulaU = "0.6 in"
    End If
    Next
End Sub

License

This article, along with any associated source code and files, is licensed under The Code Project Open License (CPOL)

Share

About the Author

bradyguy
Acxiom
United States United States
No Biography provided

Comments and Discussions

 
-- There are no messages in this forum --
| Advertise | Privacy | Terms of Use | Mobile
Web01 | 2.8.1411023.1 | Last Updated 23 Jan 2012
Article Copyright 2012 by bradyguy
Everything else Copyright © CodeProject, 1999-2014
Layout: fixed | fluid