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:
- Save the IconBuilderTools.vss stencil to your My Shapes folder (under Documents)
- From your drawing document, click More Shapes / My Shapes and open the IconBuilderTools stencil
- Select your target shape that you want to be the host for the icons (or draw a new rectangle just to try it out)
- Press Alt+F8 key to open the Macros dialog and select the IconBuilderTools.vss stencil from the ‘Macros in:’ drop down
- You should now see two procedures. Select the SetGroupShapeIconCells and hit the Run button
- 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
- 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
- With all of the shape correctly selected, you can now run the second procedure (Alt+F8) named SetSubShapeIconCells
- 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)
- 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:
1: Dim iPositions As Integer
2: iPositions = InputBox("How many icon positions do you want to add?", procName, "5")
3:
4: Dim cellsDict As New Scripting.Dictionary
5:
6: 'Add cell names and formulas to dictionary and
7: 'note that all double quote characters in the formulas
8: 'below have already been replaced with single quote characters
9: cellsDict.Add "User.RowHeight", "Height/20"
10: cellsDict.Add "User.ColumnWidth", "Width/20"
11: cellsDict.Add "User.PrimaryItemOffset", "IF(User.ReverseOrder,-User.DefaultGridSpan,0)"
12: cellsDict.Add "User.ReverseOrder", "1"
13: cellsDict.Add "User.DefaultGridSpan", "3"
14: cellsDict.Add "User.fxGetItemGridPosition", "User.PrimaryItemOffset+(IF(User.ReverseOrder,-1,1)*((INDEX(ARG('ItemIdx'),User.ItemsPositionList)-1)*User.DefaultGridSpan))"
15: cellsDict.Add "User.ItemsLayoutHorizontal", "1"
16: cellsDict.Add "User.FixedGridVector", "0"
17: cellsDict.Add "User.GridOriginPnt", "PNT(Width,Height)"
18: cellsDict.Add "User.DefaultItemWidth", "(User.ColumnWidth*User.DefaultGridSpan)*0.8"
19: cellsDict.Add "User.DefaultItemHeight", "(User.RowHeight*User.DefaultGridSpan)*0.8"
20: cellsDict.Add "User.DefaultLeftPadding", "(User.ColumnWidth*User.DefaultGridSpan)*0.2"
21: cellsDict.Add "User.DefaultBottomPadding", "(User.RowHeight*User.DefaultGridSpan)*0.2"
22: cellsDict.Add "User.ItemsVisibilityList", "='" & Left(Replace(String(iPositions, "1"), "1", "1;"), iPositions * 2 - 1) & "'"
23: cellsDict.Add "User.ItemsPositionList", ""
24:
25: Dim positionListFormula As String
26: Dim i As Integer
27: For i = 1 To iPositions
28: 'Build formula for PositionList cell
29: positionListFormula = positionListFormula & "User.Item" & i & "Position"
30: If Not i = iPositions Then
31: positionListFormula = positionListFormula & "&';'&"
32: End If
33:
34: 'Build icon ItemXPosition cell names and formulas
35: Dim itemXCellName As String
36: itemXCellName = "User.Item" & i & "Position"
37: cellsDict.Add itemXCellName, ""
38: If i = 1 Then
39: cellsDict(itemXCellName) = "INDEX(0,User.ItemsVisibilityList)"
40: Else
41: cellsDict(itemXCellName) = "User.Item" & i - 1 & "Position+INDEX(" & i - 1 & ",User.ItemsVisibilityList)"
42: End If
43: Next i
44:
45: cellsDict("User.ItemsPositionList") = positionListFormula
46:
47: If Not shpTarget.Type = VisShapeTypes.visTypeGroup Then
48: shpTarget.ConvertToGroup
49: End If
50:
51: shpTarget.CellsU("LockCalcWH").FormulaU = True
52:
53: 'Ensure all cells are present before adding formulas
54: Dim cellName As Variant
55: For Each cellName In cellsDict.Keys()
56: If Not shpTarget.CellExistsU(cellName, 0) Then
57: shpTarget.AddNamedRow VisSectionIndices.visSectionUser, Replace(cellName, "User.", ""), VisRowTags.visTagDefault
58: End If
59: Next
60:
61: 'Now add cell formulas
62: For Each cellName In cellsDict.Keys()
63: shpTarget.CellsU(cellName).FormulaForceU = Replace(cellsDict(cellName), "'", """")
64: 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:
