bVisual

Microsoft Office Visio has had an Org Chart Wizard for as long as I can remember (and I have been using Visio since 1996).  It has gone through several iterations, but basically it provides a simple way to create personnel hierarchies from a variety of data sources.  It even has a command line interface so that the charts can be created with a minimum of user interaction.  This is great, but it is limited.  Firstly, it does not take advantage of the new Link Data to Shapes and Data Graphics in Visio 207 Professional; secondly, it only does direct reports with just one type of layout; and thirdly, you cannot refresh the diagram easily.  Therefore, I thought it would be interesting to overcome some of these obstacles using the new features of Visio 2007 Professional and with a little code.

Visio installs a sample OrgData.xls Excel spreadsheet in the folder <Program Files>Microsoft OfficeOffice12SAMPLES1033 by default, so I have copied this file and slightly amended it.

There are plenty resources on the web to help you use the built-in Org Chart Wizard in Visio, for example : http://office.microsoft.com/en-us/visio/HA011822551033.aspx.  If you follow these in instructions, then you can produce a chart similar to the one shown below.  I have used Color By Value to automatically fill the shapes with different colors by Department.

Applying more than the Color By Value Data Graphic can be problematical because these shapes are rigorously controlled by the OrgChart addon, and I have often seen questions about modifying the appearance or layout in the newsgroups.  Customization is also complicated by the fact that there are many master shapes in the stencil, each of which can be changed to look like one of the other.  For example, an Executive can become a Consultant, or a Position can become a Manager.  This is done with the Change Position Type tool, but this does not magically swap one shape for another, but it just changes a property that changes the shapes appearance.  You may think that this is not a problem, except that any customization requires that it be done to all of the master shapes, not just one.

I slightly modified the spreadsheet to insert “mailto:” before the email address.  This will enable Link Data to Shapes to automatically understand that it is a hyperlink and create one on each shape.

I used Link Data to Shapes to a display the spreadsheet in an External Data Window in Visio.  Then I simply drew an ellipse and modified its fill, line and shading before dragging one of the records onto it.

Once there is some data on the shape, you can use the Data Graphics in Visio 2007 Professional.  I linked the Department to Color By Value again; Master_Shape to the built-in face icons, the Office_Number to a circle at the bottom, and Title, Name and Department as three lines of text in the center of the shape.  The MailTo values automatically create an hyperlink on each shape, as hoped.

After showing the Document Stencil, I dragged the shape onto it, and named the new Master as Person.

You can then use this Person master to drag and drop the records from the External Data Window onto the Visio page.  Interesting, but not a very pretty organization chart.

Now comes the clever(ish) bit.  The data recordset in the External Data Window is accessible by code.  Therefore, you can loop through the records, get the employee name, then check which other employees report to this employee.   Having got the sub-ordinate employees, you can add a connector between them.

Just for good measure, I take the opportunity to name the shapes, as I loop through them.  This makes the Drawing Explorer Window usable.

The download includes the ConnectSubordinates sub routine in the ConnectShapes module with its support functions, getColumnIndexByName; and IsArrayAllocated.

So, now we have a connected diagram.  Not very pretty, yet, but it is connected.

You can manually use Shape / Configure Layout to alter the appearance of the chart

Alternatively, you can automate the layout with code.  I have included macros in the LayoutShapes module for changing the appearance in the download, for example, LayoutPageCircular creates a diagram like this:

Or LayoutPageCompactTree and LayoutPageRadial creates diagrams like these:

You can now choose the type of chart to suit your requirements, and, of course, Visio will automatically optimize the layout if you add in extra matrix reporting.

I have included a short macro, DeleteConnectors, so that the links can be recreated when the data is refreshed. Of course, all of this can be fully automated, along with publishing to the web, PDF or Xps.

The sample files can be downloaded from here:

http://cid-3350d61bc93733a9.skydrive.live.com/self.aspx/Blogs/LinkDataOrgChart.vsd

http://cid-3350d61bc93733a9.skydrive.live.com/self.aspx/Blogs/ORGDATA.XLS

A recent newsgroup question asked for example code to demonstrate how shape data can be copied from one shape to another via a connector between the two.  This is something that others might want to do also, and not just by connecting shapes, but also by selection since you might change your mind about which shape to use, but you have already entered a lot of information on the original shape.  A good example of this might be when diagramming a network and needing to change between one type of server and another.  So, in this blog, I will demonstrate how shape data can be transferred by connection or by selection, and how to limit the transfer to rows that match by name or by label.

Note that Shape Data is the new name for Custom Properties in Visio 2007.

Firstly, I should explain why it may be necessary to match by name or by label:  In the following screenshot, you can see the Shape Data window, Define Shape Data dialog, and the ShapeSheet for a Server shape.  I have ticked “Run in developer mode” in Tools / Options / Advanced, otherwise I would not be able to see the Name, Sort key, Ask on drop or Hidden in the dialog.

A non-developer may use the Define Shape Data dialog without switching on developer mode, and thus will be oblivious to the name of the row.  In this case, Visio will assign a unique name itself in the format Row_n, where n is a number.  This type of user just uses the Label to identify the row visually, and because of this, Microsoft decided to make the Link Data to Shapes… tool in Visio 2007 Professional use the Label to match rows.  However, this tool does not leave the row name in its default format, but renames it with a _VisDM_ prefix followed by a sanitised version of the Label (without spaces and special characters).  The following screenshot is from one of the sample diagrams in Visio 2007 Professional where you can see that the last four rows were added by the Link Data to Shapes…. tool.

Coincidently, this example also shows a downside to this approach because the shape already had a row named CPU, with a label “CPU”, and the data set contained a column labelled “CPU (MHz)”, which became a row named _VisDM_CP_MHz.  These are probably meant to be the same, and I have dealt with this issue in my book Visualizing Information with Microsoft Office Visio 2007.

Other Visio tools, such as the Database Wizard, only use the name of the row to match on.  Therefore, it is necessary to be able to match by either row name or label.

The approach that I have taken in my code is gather the required cell formulae from the source shape, using a function called GetSourceData, then to copy this data, with qualifications, to target shapes, using a function called SetTargetData.

I have provided three example subs that call these functions:

1. CopyAllFromConnectedSourceToTargets
2. CopyAllFromSelectedSourceToTargets
3. CopyFromSelectedSourceToTargets

CopyAllFromConnectedSourceToTargets

I simply drew an ellipse then connected the Server shape to the ellipse with a connector.

You need to select one or more connectors before running the CopyAllFromConnectedSourceToTargets macro.  The macro will report back whether the data has been successfully transferred or not.

Now, the target ellipse shape has ll of the data that is on the source Server shape.

CopyAllFromSelectedSourceToTargets

Strangely, the Rack Mounted Server shapes in Visio Professional 2007 do not have ay Shape Data rows.

You need to first select the source Server shape, then any number of target shapes, before running the CopyAllFromSelectedSourceToTargets macro.  The macro will report back whether the data has been successfully transferred or not.

Again, the target shapes will have all of the data rows copied across.

CopyFromSelectedSourceToTargets

In the situation were the target shapes already have ay Shape Data rows, but not the values, you may not want to transfer the superfluous data rows from the source to the target. 

In this example, the Server shape has a CPU, Memory, Operating System and Hard Drive Capacity rows which are not required on the Printer shape.

As before, you need to first select the source Server shape, then any number of target shapes, before running the CopyFromSelectedSourceToTargets macro.  The macro will report back whether the data has been successfully transferred or not.  Note that the Shape Data window only displays common rows when multiple shapes are selected.

This time, the target shapes will have the shared data rows copied across.

Code Listings

This code is an example of what can done, but you may need to add more error detection for your own requirements.

The aficionados amongst you may spot tat I am not using GetFormulas or SetFormulas methods in the following code.  This is because I need to get the row name, which is not available in either method.

Option Explicit
‘Author : David Parker, Microsoft MVP (Visio)
‘Date   : 2nd Feb 2009
‘Purpose: Demonstrate how shape data can be transferred from one shape to another

Public Sub CopyAllFromConnectedSourceToTargets()
‘Transfer data rows from the connected shape at the start of a connector to the connected shape at the end
If Visio.ActiveWindow.Selection.Count = 0 Then
    Exit Sub
End If
Const allCells As Boolean = False
Const forceAdd As Boolean = True
Const matchByName As Boolean = True
Const matchByLabel As Boolean = True
Dim vSource As Variant
Dim cnx As Visio.Connect
Dim shp As Visio.Shape
Dim toShape As Visio.Shape
Dim fromShape As Visio.Shape

    For Each shp In Visio.ActiveWindow.Selection
        Set toShape = Nothing
        Set fromShape = Nothing
        ‘Test if there are connected shapes at either end
        For Each cnx In shp.Connects
            If cnx.FromCell.Name = "BeginX" Then
                Set fromShape = cnx.ToSheet
            ElseIf cnx.FromCell.Name = "EndX" Then
                Set toShape = cnx.ToSheet
            End If
        Next cnx
        ‘Now tranfer data f a source and target were found
       If Not toShape Is Nothing And Not fromShape Is Nothing Then
            vSource = GetSourceData(fromShape, allCells)
            If SetTargetData(toShape, allCells, forceAdd, matchByName, matchByLabel, vSource) Then
                MsgBox "Data successfully transferred to " & toShape.Name
            Else
                MsgBox "Data failed to transfer to " & toShape.Name
            End If
        End If
    Next shp

End Sub

Public Sub CopyAllFromSelectedSourceToTargets()
‘Transfer all data rows from the primary selected shape to all other selected shapes
If Visio.ActiveWindow.Selection.Count = 0 Then
    Exit Sub
End If
Const allCells As Boolean = True
Const forceAdd As Boolean = True
Const matchByName As Boolean = True
Const matchByLabel As Boolean = True
Dim vSource As Variant
    vSource = GetSourceData(Visio.ActiveWindow.Selection.PrimaryItem, allCells)
Dim shp As Visio.Shape
Dim iShp As Integer
    For iShp = 2 To Visio.ActiveWindow.Selection.Count
        Set shp = Visio.ActiveWindow.Selection.Item(iShp)
        If SetTargetData(shp, allCells, forceAdd, matchByName, matchByLabel, vSource) Then
            MsgBox "Data successfully transferred to " & shp.Name
        Else
            MsgBox "Data failed to transfer to " & shp.Name
        End If
    Next iShp
End Sub

Public Sub CopyFromSelectedSourceToTargets()
‘Transfer matching data rows from the primary selected shape to all other selected shapes
If Visio.ActiveWindow.Selection.Count = 0 Then
    Exit Sub
End If
Const allCells As Boolean = False
Const forceAdd As Boolean = False
Const matchByName As Boolean = True
Const matchByLabel As Boolean = True
Dim vSource As Variant
    vSource = GetSourceData(Visio.ActiveWindow.Selection.PrimaryItem, allCells)
Dim shp As Visio.Shape
Dim iShp As Integer
    For iShp = 2 To Visio.ActiveWindow.Selection.Count
        Set shp = Visio.ActiveWindow.Selection.Item(iShp)
        If SetTargetData(shp, allCells, forceAdd, matchByName, matchByLabel, vSource) Then
            MsgBox "Data successfully transferred to " & shp.Name
        Else
            MsgBox "Data failed to transfer to " & shp.Name
        End If
    Next iShp
End Sub

Public Function GetSourceData(ByVal shp As Visio.Shape, ByVal allCells As Boolean) As Variant
‘Get the data from a shape, optionally getting all cells
On Error GoTo errHandler
Dim iRows As Integer
    iRows = shp.RowCount(Visio.VisSectionIndices.visSectionProp)
    If iRows = 0 Then
        GetSourceData = Nothing
        Exit Function
    End If

Dim iCellsPerRow As Integer
    If allCells Then
        iCellsPerRow = 11
    Else
        iCellsPerRow = 3
    End If

ReDim avarFormulaArray(1 To (iRows * iCellsPerRow)) As Variant

Dim iRow As Integer
Dim iCellPerRow As Integer
Dim iCell As Integer

    For iRow = 0 To iRows – 1
        For iCellPerRow = 1 To iCellsPerRow
            iCell = (iRow * iCellsPerRow) + 1
            avarFormulaArray(iCell) = shp.CellsSRC(Visio.VisSectionIndices.visSectionProp, iRow, Visio.VisCellIndices.visCustPropsValue).RowNameU
            avarFormulaArray(iCell + 1) = shp.CellsSRC(Visio.VisSectionIndices.visSectionProp, iRow, Visio.VisCellIndices.visCustPropsLabel).FormulaU
            avarFormulaArray(iCell + 2) = shp.CellsSRC(Visio.VisSectionIndices.visSectionProp, iRow, Visio.VisCellIndices.visCustPropsValue).FormulaU
           If allCells Then
                avarFormulaArray(iCell + 3) = shp.CellsSRC(Visio.VisSectionIndices.visSectionProp, iRow, Visio.VisCellIndices.visCustPropsPrompt).FormulaU
                avarFormulaArray(iCell + 4) = shp.CellsSRC(Visio.VisSectionIndices.visSectionProp, iRow, Visio.VisCellIndices.visCustPropsType).FormulaU
                avarFormulaArray(iCell + 5) = shp.CellsSRC(Visio.VisSectionIndices.visSectionProp, iRow, Visio.VisCellIndices.visCustPropsFormat).FormulaU
                avarFormulaArray(iCell + 6) = shp.CellsSRC(Visio.VisSectionIndices.visSectionProp, iRow, Visio.VisCellIndices.visCustPropsSortKey).FormulaU
                avarFormulaArray(iCell + 7) = shp.CellsSRC(Visio.VisSectionIndices.visSectionProp, iRow, Visio.VisCellIndices.visCustPropsInvis).FormulaU
                avarFormulaArray(iCell + 8) = shp.CellsSRC(Visio.VisSectionIndices.visSectionProp, iRow, Visio.VisCellIndices.visCustPropsAsk).FormulaU
                avarFormulaArray(iCell + 9) = shp.CellsSRC(Visio.VisSectionIndices.visSectionProp, iRow, Visio.VisCellIndices.visCustPropsLangID).FormulaU
                avarFormulaArray(iCell + 10) = shp.CellsSRC(Visio.VisSectionIndices.visSectionProp, iRow, Visio.VisCellIndices.visCustPropsCalendar).FormulaU
            End If
        Next iCellPerRow
    Next iRow

    GetSourceData = avarFormulaArray
exitHere:
    Exit Function
errHandler:
    MsgBox Err.Description, vbCritical, "GetSourceData"
    Resume exitHere
End Function

Public Function SetTargetData(ByVal shp As Visio.Shape, ByVal allCells As Boolean, _
    ByVal forceAdd As Boolean, ByVal matchByName As Boolean, ByVal matchByLabel As Boolean, _
    ByVal aryData As Variant) As Boolean
‘Set the data on surce shape, optionally copying all cells, forcing an add, matching by row name or label
On Error GoTo errHandler

Dim iCellsPerRow As Integer
    If allCells Then
        iCellsPerRow = 11
    Else
        iCellsPerRow = 3
    End If
Dim totalCells As Integer
    totalCells = UBound(aryData)
    If totalCells = 0 Then
        SetTargetData = False
        Exit Function
    End If
Dim iRows As Integer
    iRows = shp.RowCount(Visio.VisSectionIndices.visSectionProp)
   If shp.SectionExists(Visio.VisSectionIndices.visSectionProp, Visio.VisExistsFlags.visExistsAnywhere) = False Then
        shp.AddSection Visio.VisSectionIndices.visSectionProp
    End If

Dim iRowsAddedToTarget As Integer
Dim iRowTarget As Integer
Dim iRow As Integer
Dim iCell As Integer
Dim rowName As String
Dim rowLabel As String
Dim iRowTest As Integer

    For iRow = 1 To totalCells Step iCellsPerRow
        iRowTarget = -1
        rowName = aryData(iRow)
        rowLabel = aryData(iRow + 1)
        If matchByName Then
            ‘Firstly, test if row name exists
            If Not shp.CellExistsU("Prop." & rowName, Visio.visExistsAnywhere) = 0 Then
                iRowTarget = shp.CellsU("Prop." & rowName).Row
           End If
        End If
        If iRowTarget < 0 And matchByLabel Then
            ‘Secondly, test if label exists
            For iRowTest = 0 To shp.RowCount(Visio.VisSectionIndices.visSectionProp) – 1
                If UCase(shp.CellsSRC(Visio.VisSectionIndices.visSectionProp, iRowTest, Visio.VisCellIndices.visCustPropsLabel).ResultStr("")) = UCase(rowLabel) Then
                    iRowTarget = iRowTest
                    Exit For
                End If
            Next iRowTest
        End If
        If forceAdd And iRowTarget < 0 Then
            If matchByName Then
                iRowTarget = shp.AddNamedRow(Visio.VisSectionIndices.visSectionProp, rowName, 0)
            Else
                iRowTarget = shp.AddRow(Visio.VisSectionIndices.visSectionProp, shp.RowCount(Visio.VisSectionIndices.visSectionProp), 0)
            End If
        End If
        If iRowTarget > -1 Then
            setCellFormula shp, Visio.VisSectionIndices.visSectionProp, iRowTarget, Visio.VisCellIndices.visCustPropsLabel, aryData(iRow + 1)
            setCellFormula shp, Visio.VisSectionIndices.visSectionProp, iRowTarget, Visio.VisCellIndices.visCustPropsValue, aryData(iRow + 2)
            If allCells Then
                setCellFormula shp, Visio.VisSectionIndices.visSectionProp, iRowTarget, Visio.VisCellIndices.visCustPropsPrompt, aryData(iRow + 3)
                setCellFormula shp, Visio.VisSectionIndices.visSectionProp, iRowTarget, Visio.VisCellIndices.visCustPropsType, aryData(iRow + 4)
                setCellFormula shp, Visio.VisSectionIndices.visSectionProp, iRowTarget, Visio.VisCellIndices.visCustPropsFormat, aryData(iRow + 5)
                setCellFormula shp, Visio.VisSectionIndices.visSectionProp, iRowTarget, Visio.VisCellIndices.visCustPropsSortKey, aryData(iRow + 6)
                setCellFormula shp, Visio.VisSectionIndices.visSectionProp, iRowTarget, Visio.VisCellIndices.visCustPropsInvis, aryData(iRow + 7)
                setCellFormula shp, Visio.VisSectionIndices.visSectionProp, iRowTarget, Visio.VisCellIndices.visCustPropsAsk, aryData(iRow + 8)
                setCellFormula shp, Visio.VisSectionIndices.visSectionProp, iRowTarget, Visio.VisCellIndices.visCustPropsLangID, aryData(iRow + 9)
                setCellFormula shp, Visio.VisSectionIndices.visSectionProp, iRowTarget, Visio.VisCellIndices.visCustPropsCalendar, aryData(iRow + 10)
            End If
        End If
    Next iRow

    SetTargetData = True
exitHere:
    Exit Function
errHandler:
    MsgBox Err.Description, vbCritical, "SetTargetData"
    Resume exitHere
End Function

Private Sub setCellFormula(ByVal shp As Visio.Shape, _
    ByVal iSect As Integer, ByVal iRow As Integer, ByVal iCell As Integer, _
    ByVal formula As String)
    ‘Transfer cell formula if different
   If Not shp.CellsSRC(iSect, iRow, iCell).FormulaU = formula Then
        shp.CellsSRC(iSect, iRow, iCell).FormulaForceU = formula
    End If
End Sub

Alternatively, you can download the code from : CopyingShapeData.vsd