The wireframing template in Visio has a treeview control to that allows you to add and remove items, and set their respective indent levels. By default you can only adjust a single item at a time and even if you create a multiple selection, only the primary item is effected. A forum question asked how you could make a single change to multiple items and I thought I would write a quick bit of code to show how you might go about it.
The Visio tree control
The tree control in Visio, (found in the ‘Controls’ stencil) makes use of the structured diagramming functionality introduced in 2010 and is a ‘List’ type. Basically, an outer List shape (green outline below) hosts a number of tree control item shapes and each of these can have an indent level set via the context menu:
If you have a look inside the ShapeSheet, you’ll see that these indent related context menu items change a couple of other cells in the shape to alter its position (at least the sub-shape positions) and size. Here’s a screenshot of the formula for the ‘Increase Indent’ Action cell:
The first SETF function is basically pushing an incremented value into the TreeLevel user cell and this is followed by a second SETF pushing a new calculated width into the Width cell. The Decrease formula is almost identical, just with the values heading in the opposite direction.
Code options
So in terms of creating some code, this is just a case of getting hold of the selected shapes, looping through each one and setting the appropriate values.
Given, though, that all of the correct logic is already built into the shape, my first approach was to just fire the context menu item using the Trigger method of the Cell object. This works well and allows you to keep the code fairly agnostic about how the indent logic works - which I like. The downside is that it appears not to play very happily with Undo functionality, so I’m also going to show a second option that, for my liking, has way too much knowledge about the internal workings of the shape, but, it does work with Undo. Which one you choose or modify is up to you.
So here’s the cell trigger version:
Public Sub IncreaseTreeItemsIndent()
Call ChangeTreeItemsIndent(True)
End Sub
Public Sub DecreaseTreeItemsIndent()
Call ChangeTreeItemsIndent(False)
End Sub
Private Sub ChangeTreeItemsIndent(IsIncrease As Boolean)
Dim procText As String
If IsIncrease Then
procText = "Increase tree items indent"
Else
procText = "Decrease tree items indent"
End If
If ActiveWindow.Type <> VisWinTypes.visDrawing Then
MsgBox "Please select a drawing window to use this procedure.", _
vbExclamation, procText
Else
Dim sMenuName As String
If IsIncrease Then
sMenuName = "Increase Indent"
Else
sMenuName = "Decrease Indent"
End If
Dim shpTreeItem As Shape
For Each shpTreeItem In ActiveWindow.Selection
If shpTreeItem.Master.NameU = "Tree control item" Then
Dim iTargetRow As Integer
iTargetRow = GetActionRowIndex(shpTreeItem, sMenuName)
If iTargetRow >= 0 Then
If shpTreeItem.CellsSRC(visSectionAction, iTargetRow, visActionDisabled).ResultIU = False Then
shpTreeItem.CellsSRC(visSectionAction, iTargetRow, visActionAction).Trigger
End If
End If
End If
Next shpTreeItem
End If
End Sub
Private Function GetActionRowIndex(ByRef shpIn As Visio.Shape, sMenuName As String) As Integer
Dim iRow As Integer
iRow = -1
If Not shpIn Is Nothing Then
If shpIn.SectionExists(visSectionAction, 0) Then
Dim i As Integer
Dim menuCellTxt As String
For i = 0 To shpIn.Section(visSectionAction).Count - 1
menuCellTxt = shpIn.CellsSRC(visSectionAction, i, visActionMenu).ResultStrU("")
If GetCleanMenuText(menuCellTxt) = sMenuName Then
iRow = i
Exit For
End If
Next i
End If
End If
GetActionRowIndex = iRow
End Function
Private Function GetCleanMenuText(strIn As String) As String
Dim cleanedStr As String
cleanedStr = Replace(strIn, "&", "")
cleanedStr = Replace(cleanedStr, "_", "")
GetCleanMenuText = cleanedStr
End Function
…and here’s the second version, which includes Undo:
Public Sub IncreaseTreeItemsIndent()
Call ChangeTreeItemsIndent(True)
End Sub
Public Sub DecreaseTreeItemsIndent()
Call ChangeTreeItemsIndent(False)
End Sub
Private Sub ChangeTreeItemsIndent(IsIncrease As Boolean)
Dim procText As String
If IsIncrease Then
procText = "Increase tree items indent"
Else
procText = "Decrease tree items indent"
End If
If ActiveWindow.Type <> VisWinTypes.visDrawing Then
MsgBox "Please select a drawing window to use this procedure.", _
vbExclamation, procText
Else
Dim lngScopeID As Long
lngScopeID = Application.BeginUndoScope(procText)
Dim sMenuName As String
If IsIncrease Then
sMenuName = "Increase Indent"
Else
sMenuName = "Decrease Indent"
End If
Dim shpTreeItem As Shape
For Each shpTreeItem In ActiveWindow.Selection
If shpTreeItem.Master.NameU = "Tree control item" Then
Dim cellUserLevel As Cell
Set cellUserLevel = shpTreeItem.CellsU("User.TreeLevel")
Dim placeHlderAndSpacing As Double
placeHlderAndSpacing = shpTreeItem.CellsU("User.placeholderWidth").ResultIU _
+ shpTreeItem.CellsU("User.spacing").ResultIU
Dim itemWidthInches As Double
itemWidthInches = shpTreeItem.CellsU("Width").ResultIU
If IsIncrease And cellUserLevel.ResultIU < 10 Then
cellUserLevel.ResultIU = cellUserLevel.ResultIU + 1
shpTreeItem.CellsU("Width").ResultIU = itemWidthInches + placeHlderAndSpacing
ElseIf IsIncrease = False And cellUserLevel.ResultIU > 0 Then
cellUserLevel.ResultIU = cellUserLevel.ResultIU - 1
shpTreeItem.CellsU("Width").ResultIU = itemWidthInches - placeHlderAndSpacing
End If
End If
Next shpTreeItem
Application.EndUndoScope lngScopeID, True
End If
End Sub
Note that the second version sets the indent level and width cells directly, and, knows about the maximum indent levels (10), not all of which is a good thing. The first version relies just on invoking the menu item and deals with the max indent by interrogating the the menu items disabled cell (which is where the real logic actually lives.
Extending shape functionality in this way always depends on how it’s intended to be used. If you’re wanting to distribute your solution across a wide audience, then an addin or similar is a better option, but if you’re a sole user then VBA still provides a very viable option.