Setting Visio icon sub-shapes code utility

A couple of posts ago I covered one way of adding ‘Positioning icons in a Visio group shape’.  This post follows up with a small code utility to take some of the leg work out of adding all of the group and sub-shape cells.

If you remember from the earlier post, the group shape basically defines a grid system that the icon sub-shapes can hook into to get their position based on an index.

I’ve wrapped the code up into a stencil document that works with the active selection.  This means that you should be able to open the stencil in your target drawing document, run the utility code and close the stencil again.

The stencil has two procedures: one to setup the group shape and a second to add the icon sub-shapes.

Here’s a quick walkthrough:

1. Save the IconBuilderTools.vss stencil to your My Shapes folder (under Documents)
2. From your drawing document, click More Shapes / My Shapes and open the IconBuilderTools stencil
3. Select your target shape that you want to be the host for the icons (or draw a new rectangle just to try it out)
4. Press Alt+F8 key to open the Macros dialog and select the IconBuilderTools.vss stencil from the ‘Macros in:’ drop down
5. You should now see two procedures.  Select the SetGroupShapeIconCells and hit the Run button
6. An input box will appear and you can select how many icon positions you’d like to add (the default is five) and press OK
7. Now, either add five more small rectangle as a test, or select the icon shapes that you want to add.  Note that the host group shape must be the primary selected item so you’ll need to select this first and then add the icon shapes by holding the Ctrl key while selecting
8. With all of the shape correctly selected, you can now run the second procedure (Alt+F8) named SetSubShapeIconCells
9. At this stage you should be presented with a message box asking whether you want to set protection on the sub-shapes.  (This simply writes to the Lock cells the ShapeSheet’s Protection section)
10. You should now have a group shape with icons included as sub-shapes.

In terms of the code, I’ve used a Dictionary object to populate the various cell names and formulas so that I can then run through in two parses: one to check that all of the cells exist and then a second to add the formulas themselves.

Given that this is a utility function and not used frequently, I’m more interested in flexibility and code readability than performance and I think the Dictionary helps with this.

Here’s a listing from the group shape procedure with error handling and a few other odd lines removed for clarity:

Dim iPositions As Integer
iPositions = InputBox("How many icon positions do you want to add?", procName, "5")
    
Dim cellsDict As New Scripting.Dictionary

'Add cell names and formulas to dictionary and
'note that all double quote characters in the formulas
'below have already been replaced with single quote characters
cellsDict.Add "User.RowHeight", "Height/20"
cellsDict.Add "User.ColumnWidth", "Width/20"
cellsDict.Add "User.PrimaryItemOffset", "IF(User.ReverseOrder,-User.DefaultGridSpan,0)"
cellsDict.Add "User.ReverseOrder", "1"
cellsDict.Add "User.DefaultGridSpan", "3"
cellsDict.Add "User.fxGetItemGridPosition", "User.PrimaryItemOffset+(IF(User.ReverseOrder,-1,1)*((INDEX(ARG('ItemIdx'),User.ItemsPositionList)-1)*User.DefaultGridSpan))"
cellsDict.Add "User.ItemsLayoutHorizontal", "1"
cellsDict.Add "User.FixedGridVector", "0"
cellsDict.Add "User.GridOriginPnt", "PNT(Width,Height)"
cellsDict.Add "User.DefaultItemWidth", "(User.ColumnWidth*User.DefaultGridSpan)*0.8"
cellsDict.Add "User.DefaultItemHeight", "(User.RowHeight*User.DefaultGridSpan)*0.8"
cellsDict.Add "User.DefaultLeftPadding", "(User.ColumnWidth*User.DefaultGridSpan)*0.2"
cellsDict.Add "User.DefaultBottomPadding", "(User.RowHeight*User.DefaultGridSpan)*0.2"
cellsDict.Add "User.ItemsVisibilityList", "='" & Left(Replace(String(iPositions, "1"), "1", "1;"), iPositions * 2 - 1) & "'"
cellsDict.Add "User.ItemsPositionList", ""

Dim positionListFormula As String
Dim i As Integer
For i = 1 To iPositions
    'Build formula for PositionList cell
    positionListFormula = positionListFormula & "User.Item" & i & "Position"
    If Not i = iPositions Then
        positionListFormula = positionListFormula & "&';'&"
    End If

    'Build icon ItemXPosition cell names and formulas
    Dim itemXCellName As String
    itemXCellName = "User.Item" & i & "Position"
    cellsDict.Add itemXCellName, ""
    If i = 1 Then
        cellsDict(itemXCellName) = "INDEX(0,User.ItemsVisibilityList)"
    Else
        cellsDict(itemXCellName) = "User.Item" & i - 1 & "Position+INDEX(" & i - 1 & ",User.ItemsVisibilityList)"
    End If
Next i

cellsDict("User.ItemsPositionList") = positionListFormula

If Not shpTarget.Type = VisShapeTypes.visTypeGroup Then
    shpTarget.ConvertToGroup
End If

shpTarget.CellsU("LockCalcWH").FormulaU = True 

'Ensure all cells are present before adding formulas
Dim cellName As Variant
For Each cellName In cellsDict.Keys()
    If Not shpTarget.CellExistsU(cellName, 0) Then
        shpTarget.AddNamedRow VisSectionIndices.visSectionUser, Replace(cellName, "User.", ""), VisRowTags.visTagDefault
    End If
Next

'Now add cell formulas
For Each cellName In cellsDict.Keys()
    shpTarget.CellsU(cellName).FormulaForceU = Replace(cellsDict(cellName), "'", """")
Next

The icon sub-shape procedure follows a similar pattern, ie creating a Dictionary and then running through the Dictionary twice to add the cells and then the formulas.

You’re obviously free to change the code as you see fit and you can download the stencil document here:

• IconBuilderTools.vss (.zip) stencil