Click here to Skip to main content
13,350,486 members (63,909 online)
Click here to Skip to main content
Add your own
alternative version

Tagged as


Posted 20 Jan 2012

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

, 23 Jan 2012
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
    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
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
End Sub


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


About the Author

United States United States

You may also be interested in...


Comments and Discussions

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