Visio Shape Explorer

To be able to create the Visio Visual Section document meant, I needed to mine the information from Visio shapes. The easiest way was to let loose CellsSrc() on a series of shapes and let the code create a file of what it found.

Visio is big on using enumerations, but they are not good at fully documenting them. So, to be able to create the Visio Visual Section document I had to treat the sections as Pokemon and had to play “Pokemon-Got to Find them all”. If my code could not find the name of an enumeration type, it used “Missing Jxxx” as the text version of the enumeration. As you can see below, the section name for J197 was missing, but the section number and row number <245-0> provided a clue. I just had to look up the reference in one of Graham Wideman’s books. The lines following the section name row are the cells for that Section. Since the code extracts the cell name from the shape in the file it is is easy to confirm the section name or make a good guess at what the section name is.

Option Explicit
Dim MsgDict As Dictionary, SectNo As Integer
Sub ShapeExplorer()
Dim TxtFileName As String, vsoshp As Visio.Shape
TxtFileName = CurDir() & "\" & "Shape Explorer.doc"
Open TxtFileName For Output Shared As #1
Call LoadMsgDict
Set vsoshp = ActiveDocument.DocumentSheet
Call ProcessShape(vsoshp)
Set vsoshp = ActiveWindow.Page.PageSheet
Call ProcessShape(vsoshp)
For Each vsoshp In ActivePage.Shapes
    Call ProcessShape(vsoshp)
Next vsoshp
Close #1
End Sub
Sub ProcessShape(vsoShape As Visio.Shape)
Dim curcell As Integer, curRow As Integer, ncells As Integer, nRows As Integer, RowCnt As Integer, RT As Integer
Print #1, "<H1>ShapeName="; vsoShape.Name
For SectNo = 1 To visSectionLast
    nRows = vsoShape.RowCount(SectNo)
    If nRows > 0 Then Print #1, "SectNo="; Trim(SectNo); " nRows="; Trim(nRows); " "; vsoShape.RowExists(SectNo, 0, visExistsAnywhere)
    Select Case SectNo
    Case visSectionObject:  Call HandleCells(vsoShape)                                    '  1
    Case 2 To visSectionControls: Call HandleCells(vsoShape)                              '  2 ->   9
    Case visSectionFirstComponent To visSectionLastComponent: Call HandleCells(vsoShape)  ' 10 -> 239
    Case visSectionAction To visSectionLast: Call HandleCells(vsoShape)                   '240 -> 252
   Case Else: Print #1, "SectNo="; Trim(SectNo); " nRows="; Trim(nRows)
End Select
Next SectNo
End Sub
Sub HandleCells(vsoshp As Visio.Shape)
Dim curcell As Integer, curRow As Integer, ncells As Integer, RT As Integer
For curRow = 0 To 512
   If vsoshp.RowExists(SectNo, curRow, visExistsAnywhere) Then
       ncells = vsoshp.RowsCellCount(SectNo, curRow)
       RT = vsoshp.RowType(SectNo, curRow)
       Print #1, "<H2><"; Trim(SectNo); "-"; Trim(curRow); "> "; GetMsgName(RT); " nCells="; Trim(ncells)
       For curcell = 0 To ncells - 1
           Print #1, "<"; Trim(SectNo); "-"; Trim(curRow); "-"; Trim(curcell); "/"; Trim(ncells); ">";
           Print #1, " N="; vsoshp.CellsSRC(SectNo, curRow, curcell).Name;
           Print #1, " F=" & vsoshp.CellsSRC(SectNo, curRow, curcell).Formula;
           Print #1, " R=" & vsoshp.CellsSRC(SectNo, curRow, curcell).ResultStr(visNone)
       Next curcell
   End If
Next curRow
End Sub

To be able to convert enumerations into text, I used a dictionary. Actually, any time I need to translate enumerations into text, I use a dictionary. When I have several lists, I use a single dictionary and prefix the keys with a unique letter, in this case “J”.
Just remember to go to Tools -> Reference and add Microsoft Scripting Runtime.

Function GetMsgName(MsgNo As Integer) As String
' Get the Msg text from a code Sept 12, 2022
Dim ky As String, tmpMsg As String
ky = "J" & Trim(Str(MsgNo))
If MsgDict.Exists(ky) Then
    tmpMsg = MsgDict(ky)
Else
    tmpMsg = "Missing " & ky
'    ky = "G" & Trim(Str(MsgNo))
'    If MsgDict.Exists(ky) Then tmpMsg = MsgDict(ky)
End If
GetMsgName = ky & " " & tmpMsg
'Print #1, "GetMsgName looking for "; ky; " "; GetMsgName
End Function

This is part of my dictionary.

Sub LoadMsgDict()
' load the MSG dictionary
Set MsgDict = CreateObject("Scripting.Dictionary")
MsgDict.Add Key:="J131", Item:="Character"
MsgDict.Add Key:="J132", Item:="Events"
MsgDict.Add Key:="J133", Item:="Line Format"
MsgDict.Add Key:="J134", Item:="Fill Format"
MsgDict.Add Key:="J135", Item:="Text Block Format"
MsgDict.Add Key:="J136", Item:="Tabs"
MsgDict.Add Key:="J137", Item:="Geometry"
MsgDict.Add Key:="J138", Item:="MoveTo"
MsgDict.Add Key:="J139", Item:="LineTo"
MsgDict.Add Key:="J140", Item:="ArcTo"
MsgDict.Add Key:="J141", Item:="InfiniteLine"
' this is not a complete list
End Sub

I have used this Explorer to find things that have been added since Graham Wideman created his books.

This week – – – Happy Birthday Graham!

I will be using this Visio Shape Explorer to finish off the last part of creating Visio Section shapes from real shapes.

John… Visio MVP in x-aisle
JohnVisioMVP.ca