Building Visio shapes with code

The last post on ‘Modifying the Visio Grid shape’ demonstrates how to change the resizing behaviour of a complex shape from a ShapeSheet perspective.  I used the word ‘modifying’ but, in fact, it’s actually a new shape and one built using code and it’s this aspect that I thought I’d focus on in this post. 

I’d love to encourage anyone who’s not written any code before to keep reading as I think this makes a good challenge for new coders.  If you’re in that boat then you might also want to have a quick read through Just for starters and Looping through to get you going, but the code below has lots of comments and is hopefully self explanatory.

Why code?

I think a reasonable question before you start reaching for the Alt+F12 shortcut is, why go to the bother of writing code to create a shape when there’s a perfectly good UI sitting there wait for your input?

Although you could tackle this problem manually, a code driven approach is a better option in this case, given the work involved to update each one of the hundred cell child shapes contained by the parent group.

Aside from time, you also benefit from a much greater degree of flexibility from making future changes either due to a previous error (of which there are bound to be some) or a change in the design of the shape itself. 

Of course it always depends on how much duplication is required and also what level of variation each instance requires.  For example if all of your duplicate shapes were just that, an exact copy, then even with a hundred shapes you could probably tap out Ctrl+D faster than opening the code window.  But, if you find yourself having to open the ShapeSheet for each one then the reverse is likely to be the case.

The code

The basic flow of the code is essentially to drop the parent shape and then add the children and respective formulae with the correct Sheet.ID references.  A sketched outline looks something like this:

I’ll break up the actual code into sections.  I’ve started off with a number of string constants, where they’re are used multiple times, to avoid typo bugs and to make it easier to make changes later on:

Private Const User_RowHeight_Name = "RowHeight"

Private Const User_ColumnWidth_Name = "ColumnWidth"

Private Const User_RowIndex_Name = "RowIndex"

Private Const User_ColumnIndex_Name = "ColumnIndex"

Private Const User_IsVisible_Name = "IsVisible"

Private Const User_ResizeModeIndex_Name = "ResizeModeIdx"

Private Const Prop_Rows_Name = "Rows"

Private Const Prop_Columns_Name = "Columns"

Private Const Prop_ResizeMode_Name = "ResizeMode"

Private Const Prop_RowHeight_Name = "RowHeight"

Private Const Prop_ColumnWidth_Name = "ColumnWidth"

Private Const Format_Cell_Delimiter = ";"

The main method just checks the window type before kicking off the real work in BuildGrid:

Public Sub GridBuilder()

If ActiveWindow.Type = VisWinTypes.visDrawing Then

    Call BuildGrid(ActiveWindow, _

                   10, 10, _

                   "100 mm", "50 mm", _

                   "25 mm", "5 mm")

Else

    MsgBox "Please select a drawing window before running the Grid Builder code.", vbOKOnly, "Grid Builder"

End If

End Sub

Private Sub BuildGrid(ByRef wdw As Window, _

                      ByVal rowCount As Integer, columnCount As Integer, _

                      strGridWidth As String, strGridHeight As String, _

                      strCellWidth As String, strCellHeight As String)

Dim pag As Page

Dim shpParent As Shape

'  Create Grid parent shape

Set pag = ActivePage

Set shpParent = pag.DrawRectangle(3, 3, 5, 5)

With shpParent

    '  Add new User, Shape Data and Actions sections

    .AddSection visSectionUser

    .AddSection visSectionProp

    .AddSection visSectionAction

    '  Add Row / Column count Shape Data cells

    .AddNamedRow visSectionProp, Prop_Rows_Name, visTagDefault

    .CellsSRC(visSectionProp, visRowLast, visCustPropsType).FormulaU = "1"

    .CellsSRC(visSectionProp, visRowLast, visCustPropsFormat).FormulaU = """" & CreateNumericIndexString(1, rowCount, Format_Cell_Delimiter) & """"

    .CellsSRC(visSectionProp, visRowLast, visCustPropsValue).FormulaU = "INDEX(" & rowCount - 1 & ",Prop." & Prop_Rows_Name & ".Format)"

    .AddNamedRow visSectionProp, Prop_Columns_Name, visTagDefault

    .CellsSRC(visSectionProp, visRowLast, visCustPropsType).FormulaU = "1"

    .CellsSRC(visSectionProp, visRowLast, visCustPropsFormat).FormulaU = """" & CreateNumericIndexString(1, columnCount, Format_Cell_Delimiter) & """"

    .CellsSRC(visSectionProp, visRowLast, visCustPropsValue).FormulaU = "INDEX(" & columnCount - 1 & ",Prop." & Prop_Columns_Name & ".Format)"

    '  Add resize mode cells

    .AddNamedRow visSectionProp, Prop_ResizeMode_Name, visTagDefault

    .CellsSRC(visSectionProp, visRowLast, visCustPropsType).FormulaU = "1"

    .CellsSRC(visSectionProp, visRowLast, visCustPropsFormat).FormulaU = """Size parent to cells" & Format_Cell_Delimiter & "Size cells to parent"""

    .CellsSRC(visSectionProp, visRowLast, visCustPropsValue).FormulaU = "INDEX(0,Prop." & Prop_ResizeMode_Name & ".Format)"

    .AddNamedRow visSectionUser, User_ResizeModeIndex_Name, visTagDefault

    .CellsSRC(visSectionUser, visRowLast, visUserValue).FormulaU = "LOOKUP(Prop." & Prop_ResizeMode_Name & ",Prop." & Prop_ResizeMode_Name & ".Format)"

    '  Add RowHeight / ColumnWidth User cells

    .AddNamedRow visSectionProp, Prop_RowHeight_Name, visTagDefault

    .CellsSRC(visSectionProp, visRowLast, visCustPropsType).FormulaU = "2"

    .CellsSRC(visSectionProp, visRowLast, visCustPropsValue).FormulaU = strCellHeight

    .CellsSRC(visSectionProp, visRowLast, visCustPropsInvis).FormulaU = "User." & User_ResizeModeIndex_Name & "=1"

    .AddNamedRow visSectionProp, Prop_ColumnWidth_Name, visTagDefault

    .CellsSRC(visSectionProp, visRowLast, visCustPropsType).FormulaU = "2"

    .CellsSRC(visSectionProp, visRowLast, visCustPropsValue).FormulaU = strCellWidth

    .CellsSRC(visSectionProp, visRowLast, visCustPropsInvis).FormulaU = "User." & User_ResizeModeIndex_Name & "=1"

    '  Add RowHeight / ColumnWidth Shape Data cells

    .AddNamedRow visSectionUser, User_RowHeight_Name, visTagDefault

    .CellsSRC(visSectionUser, visRowLast, visUserValue).FormulaU = "IF(User." & User_ResizeModeIndex_Name & "=0,Prop." & Prop_RowHeight_Name & ",Height/Prop." & Prop_Rows_Name & ")"

    .AddNamedRow visSectionUser, User_ColumnWidth_Name, visTagDefault

    .CellsSRC(visSectionUser, visRowLast, visUserValue).FormulaU = "IF(User." & User_ResizeModeIndex_Name & "=0,Prop." & Prop_ColumnWidth_Name & ",Width/Prop." & Prop_Columns_Name & ")"

    '  Set Width and Height cells

    .CellsSRC(visSectionObject, visRowXFormOut, visXFormHeight).FormulaU = "IF(User." & User_ResizeModeIndex_Name & "=0,Prop." & Prop_RowHeight_Name & "*Prop." & Prop_Rows_Name & ",SETATREFEXPR(" & strGridHeight & "))"

    .CellsSRC(visSectionObject, visRowXFormOut, visXFormWidth).FormulaU = "IF(User." & User_ResizeModeIndex_Name & "=0,Prop." & Prop_ColumnWidth_Name & "*Prop." & Prop_Columns_Name & ",SETATREFEXPR(" & strGridWidth & "))"

    '  Add Actions cells for context menu

    .AddNamedRow visSectionAction, "Resize0", visTagDefault

    .CellsSRC(visSectionAction, visRowLast, visActionMenu).FormulaU = "INDEX(0,Prop." & Prop_ResizeMode_Name & ".Format)"

    .CellsSRC(visSectionAction, visRowLast, visActionAction).FormulaU = "SETF(GetRef(Prop." & Prop_ResizeMode_Name & ")," & """INDEX(0""" & "&LISTSEP()&" & """Prop." & Prop_ResizeMode_Name & ".Format)""" & ")"

    .CellsSRC(visSectionAction, visRowLast, visActionChecked).FormulaU = "User." & User_ResizeModeIndex_Name & "=0"

    .AddNamedRow visSectionAction, "Resize1", visTagDefault

    .CellsSRC(visSectionAction, visRowLast, visActionMenu).FormulaU = "INDEX(1,Prop." & Prop_ResizeMode_Name & ".Format)"

    .CellsSRC(visSectionAction, visRowLast, visActionAction).FormulaU = "SETF(GetRef(Prop." & Prop_ResizeMode_Name & ")," & """INDEX(1""" & "&LISTSEP()&" & """Prop." & Prop_ResizeMode_Name & ".Format)""" & ")"

    .CellsSRC(visSectionAction, visRowLast, visActionChecked).FormulaU = "User." & User_ResizeModeIndex_Name & "=1"

    '  Set protection and behaviour cells

    .CellsSRC(visSectionObject, visRowLock, visLockCalcWH).FormulaU = "1"

    .CellsSRC(visSectionObject, visRowLock, visLockTextEdit).FormulaU = "1"

    .CellsSRC(visSectionObject, visRowLock, visLockVtxEdit).FormulaU = "1"

    .CellsSRC(visSectionObject, visRowGroup, visGroupDisplayMode).FormulaU = "1"

    .ConvertToGroup

End With

'Generate grid cell shapes and add them to the parent

Dim iRow As Integer

Dim iCol As Integer

Dim shpTempCell As Shape

Dim GridSelection As Selection

wdw.DeselectAll

Set GridSelection = wdw.Selection

GridSelection.Select shpParent, visSelect

For iRow = 1 To rowCount

    For iCol = 1 To columnCount

        Set shpTempCell = CreateGridCell(shpParent, iRow, iCol)

        If Not shpTempCell Is Nothing Then

            GridSelection.Select shpTempCell, visSelect

            Set shpTempCell = Nothing

        End If

    Next iCol

Next iRow

GridSelection.AddToGroup

End Sub

As you can see BuildGrid calls two other methods.  Firstly a little helper method that creates a delimited string for the Shape Data format cells and secondly the CreateGridCell method, which is called for each cell in the group:

Private Function CreateGridCell(shpParent As Shape, rowIdx As Integer, colIdx As Integer) As Shape

Dim shpCell As Shape

If Not shpParent Is Nothing Then

    Dim pag As Page

    Dim parentId As Integer

    Set pag = shpParent.Parent

    parentId = shpParent.ID

    Set shpCell = pag.DrawRectangle(1, 1, 2, 2)

    With shpCell

        .AddSection visSectionUser

        .AddNamedRow visSectionUser, User_RowIndex_Name, visTagDefault

        .CellsSRC(visSectionUser, visRowLast, visUserValue).FormulaU = rowIdx

        .AddNamedRow visSectionUser, User_ColumnIndex_Name, visTagDefault

        .CellsSRC(visSectionUser, visRowLast, visUserValue).FormulaU = colIdx

        'Set shape visibility

        .AddNamedRow visSectionUser, User_IsVisible_Name, visTagDefault

        '  =IF(OR(User.RowIndex>Sheet.1!Prop.Rows,User.ColumnIndex>Sheet.1!Prop.Columns),0,1)

        .CellsSRC(visSectionUser, visRowLast, visUserValue).FormulaU = "IF(OR(User." & User_RowIndex_Name & ">Sheet." & parentId & "!Prop." & Prop_Rows_Name & ",User." & User_ColumnIndex_Name & ">Sheet." & parentId & "!Prop." & Prop_Columns_Name & "),0,1)"

        .CellsSRC(visSectionFirstComponent, visRowComponent, visCompNoShow).FormulaU = "NOT(User." & User_IsVisible_Name & ")"

        'Set width and height

        .CellsSRC(visSectionObject, visRowXFormOut, visXFormHeight).FormulaU = "GUARD(Sheet." & parentId & "!User." & User_RowHeight_Name & ")"

        .CellsSRC(visSectionObject, visRowXFormOut, visXFormWidth).FormulaU = "GUARD(Sheet." & parentId & "!User." & User_ColumnWidth_Name & ")"

        'Set position (PinX and PinY)

        '  =Sheet.1!User.ColumnWidth*IF(User.IsVisible,User.ColumnIndex,1)-Sheet.1!User.ColumnWidth/2

        '  =Sheet.1!Height-Sheet.1!User.RowHeight*IF(User.IsVisible,User.RowIndex,1)+Sheet.1!User.RowHeight/2

        .CellsSRC(visSectionObject, visRowXFormOut, visXFormPinX).FormulaU = "GUARD(Sheet." & parentId & "!User." & User_ColumnWidth_Name & "*IF(User." & User_IsVisible_Name & ",User." & User_ColumnIndex_Name & ",1)-Sheet." & parentId & "!User." & User_ColumnWidth_Name & "/2)"

        .CellsSRC(visSectionObject, visRowXFormOut, visXFormPinY).FormulaU = "GUARD(Sheet." & parentId & "!Height-Sheet." & parentId & "!User." & User_RowHeight_Name & "*IF(User." & User_IsVisible_Name & ",User." & User_RowIndex_Name & ",1)+Sheet." & parentId & "!User." & User_RowHeight_Name & "/2)"

        .CellsSRC(visSectionObject, visRowLock, visLockVtxEdit).FormulaU = "1"

        .CellsSRC(visSectionObject, visRowLock, visLockRotate).FormulaU = "1"

        .CellsSRC(visSectionObject, visRowLock, visLockDelete).FormulaU = "1"

    End With

End If

Set CreateGridCell = shpCell

End Function

Private Function CreateNumericIndexString(ByVal startInt As Integer, endInt As Integer, delimiter As String) As String

Dim i As Integer

Dim IdxString As String

For i = startInt To endInt

    IdxString = IdxString & CStr(i)

    If Not i = endInt Then

        IdxString = IdxString & delimiter

    End If

Next i

CreateNumericIndexString = IdxString

End Function

Points of interest

Order – Unless it’s not apparent, the order in which you add ShapeSheet cells and formulae is important.  If you try and add a formula that references an as yet uncreated shape or cell your code will generate an exception.

Cell properties – To retrieve a reference to a particular cell you can use either the Shape.Cells/U or Shape.CellsSRC properties.  The first, which takes a simple cell name string, is arguably easier to both read and write, the second though, which takes section, row and column indices, allows you to reference a cell by index when the name isn’t needed.  This is particularly handy in this case where you’re just dropping a row onto the end of the existing rows (using the visRowLast enumeration), but also applies to the building of geometry sections.

Double quotes – If you want to add a formula that includes double quotes within the string, you add a consecutive pair of double quotes that Visio interprets as a single set to be included in the final formula.  For example, if in ShapeSheet you wanted to see this:

Prop.MyCell.Format = “One;Two”

…and you want to create this in code based on a constant for the delimiter (;) then you’d type the following:

Private Const Format_Cell_Delimiter = ";"

MyShape.CellsU(“Prop.MyCell.Format”).FormulaU =

"""One" & Format_Cell_Delimiter & "Two"""

Selections – To add children to group shapes you have to use the AddToGroup or Group methods on the Selection object.  Although you get an initial selection object via Window.Selection you can separate this from the ActiveWindow’s own selection.  If you watch the shapes being created, you’ll see the ActiveWindow selection changing as each new cell shape is dropped and this has no affect on the other selection object (‘GridSelection’) being used to create the group.

Other shapes

Although the above code is used to generate a grid shape, it hopefully demonstrates how you can generate any grouped shape based on your own logic.

Comments

[John Marshall]

John, well written.
As a sidebar, I would add a comment about what language this was written in and what languages can be used. Actually, this is sounding like the basis for another blog.

[John Goldsmith]

You're quite right John, I completely failed to mention that this is written in VBA. Any other .net flavour would work just as well but, even though I spend most of my time in Visual Studio, I would still start in VBA for this type of thing - frankly you could write half of it in VBA by the time VS has started up.

All the best

John