The adventures of Visio section shapes continues

A while back I created a stencil of Visio section shapes. They were based on screen shots of the Shapesheet, I added control handles to adjust “cell” widths. The cells content was stored in Excel. I then loaded the “cell” contents from Excel. So, I had shapes that looked like Shapesheet sections, but they had static information.

Why do it? At the time I felt that the documentation needed something more than screen shots. A Shapesheet has a lot of information and also has some noise cells like Calendar and LangId they are important, but they add to the noise for new users. The cells the author is talking about could be highlighted with cells with different background colour or text. (that sounds like a Visio shape). Clearing cells in the section gives visual precedence to the key cells, but retaining the key cells relative position.

For example, The red cells affect the width and the blue cells affect the height.

In preparation for the next step, using live data, I switched from Excel to VBA dictionaries within Visio. Since VBA did not like the module size, I switched from using classes with the dictionaries to using a single string with a delimited text. I am not abandoning Excel, it is still a great tool for managing data used within Visio. Though the Shapesheet looks Execl like, you can not reorder rows. So if I have a project that has a lot of shape data or user data, I will store it in Excel and use VBA to import it. I also will create Control, Action or other sections using VBA.

All the information I need is in Excel, so it is just a matter of adding two columns, one for the section dictionary and one for the cells dictionary. adding two cells that build the Dict.Add command using existing cells and then replicate down. Then it is just a matter of selecting the column copy and pasting in Word, select the table and do a Convert to Text. Now you have raw text that can be pasted in the VBA module.

The information for populating the shapes is available through CellsSrc(section, row, cells). unfortunately it used enumerations and the key seemed to be RowType, but that was an enumeration list only the Geometry section was documented. So I needed a way to mine the information, so I came up with some VBA code that loops through the sections, row and cells. With a bit of playing i came up with.

Dim MsgDict As Dictionary
Public Sub DumpShapes()
Dim TxtFileName As String
Dim vsoShape As Visio.Shape
TxtFileName = CurDir() & "\" & "Dump Shapes.doc"
Open TxtFileName For Output Shared As #1
Set MsgDict = CreateObject("Scripting.Dictionary")
Call LoadDictionary
Set vsoShape = ActivePage.Shapes(1)
Call ProcessShape(vsoShape)
Close #1
End Sub
Sub ProcessShape(VsoShp As Visio.Shape)
Dim curCell As Integer, curSectNo As Integer, curSectNoIndx As Integer
Dim curRow As Integer, nCells As Integer, nrows As Integer
Dim RowCnt As Integer, RT As Integer, SectNo As Integer, tmpSectNo As Integer
For SectNo = 1 To 255
    nrows = VsoShp.RowCount(SectNo)
    If VsoShp.SectionExists(SectNo, visExistsAnywhere) Then
     tmpSectNo = SectNo: If SectNo > 9 And SectNo < 24 Then tmpSectNo = 10
        RT = VsoShp.RowType(SectNo, 0)
     Print #1, "Section ="; SectNo; GetMsgName("J", RT); " nRows ="; nrows
        Select Case SectNo
        Case visSectionObject
            For curRow = 1 To 512
                If VsoShp.RowExists(SectNo, curRow, 1) Then
                    Print #1, "<"; Trim(SectNo); "-"; Trim(curRow); "> ";
                    RT = VsoShp.RowType(SectNo, curRow)
                    nCells = VsoShp.RowsCellCount(SectNo, curRow)
                   Print #1, GetMsgName("J", RT); " nCells="; Trim(nCells)
                    For curCell = 0 To nCells - 1
                 If VsoShp.CellsSRCExists(SectNo, curRow, curCell, 1) Then
                            Print #1, "<"; Trim(SectNo); "-"; Trim(curRow); "-"; Trim(curCell); "/"; Trim(nCells); "> "; GetMsgName("J", RT); " ";
Print #1, " N="; VsoShp.CellsSRC(SectNo, curRow, curCell).Name;
Print #1, " F=" & VsoShp.CellsSRC(SectNo, curRow, curCell).Formula
                         End If
                    Next curCell
                End If
            Next curRow
        Case 10 To 25
            nrows = VsoShp.RowCount(SectNo)
            For curRow = 0 To (nrows - 1)
                RT = VsoShp.RowType(SectNo, curRow)
                nCells = VsoShp.RowsCellCount(SectNo, curRow)
                Print #1, "<"; Trim(SectNo); "-"; Trim(curRow); "> ";
                Print #1, GetMsgName("G", RT);
                If RT = 137 Then Print #1, "."; Trim(SectNo - 9);
                Print #1, " nCells="; Trim(nCells)
                For curCell = 0 To nCells - 1
                    Print #1, "<"; Trim(SectNo); "-"; Trim(curRow); "/";
Print #1,  Trim(nrows); "-"; Trim(curCell); "/"; Trim(nCells); "> ";
                    Print #1, " N="; VsoShp.CellsSRC(SectNo, curRow, curCell).Name;
                    Print #1, " F=" & VsoShp.CellsSRC(SectNo, curRow, curCell).Formula
                Next curCell
            Next curRow
        Case Else
            nrows = VsoShp.RowCount(SectNo)
            For curRow = 0 To (nrows - 1)
                RT = VsoShp.RowType(SectNo, curRow)
                nCells = VsoShp.RowsCellCount(SectNo, curRow)
                Print #1, GetMsgName("J", RT)
                Print #1, vbCrLf; "<"; Trim(SectNo); "-"; Trim(curRow); "> "; GetMsgName("J", RT); " ";
                Print #1, Trim(curRow); "/"; Trim(nrows); " nCells="; Trim(nCells)
                For curCell = 0 To nCells - 1
                    Print #1, "<"; Trim(SectNo); "-"; Trim(curRow); "/"; Trim(nrows); "-";
                    Print #1, Trim(curCell); "/"; Trim(nCells); "> ";
                    Print #1, " N="; VsoShp.CellsSRC(SectNo, curRow, curCell).Name;
                    Print #1, " F=" & VsoShp.CellsSRC(SectNo, curRow, curCell).Formula
                Next curCell
            Next curRow
        End Select
End If
Next SectNo
End Sub
Sub LoadDictionary()
Set MsgDict = CreateObject("Scripting.Dictionary")
MsgDict.Add key:="G0", Item:="Default"
MsgDict.Add key:="G136", Item:="Tab0"
MsgDict.Add key:="G137", Item:="Geometry"
MsgDict.Add key:="G138", Item:="MoveTo"
MsgDict.Add key:="G139", Item:="LineTo"
MsgDict.Add key:="G140", Item:="ArcTo"
MsgDict.Add key:="G141", Item:="InfiniteLine"
MsgDict.Add key:="G143", Item:="Ellipse"
MsgDict.Add key:="G144", Item:="EllipticalArcTo"
MsgDict.Add key:="G150", Item:="Tab2"
MsgDict.Add key:="G151", Item:="Tab10"
MsgDict.Add key:="G153", Item:="CnnctPt"
MsgDict.Add key:="G162", Item:="CtlPt"
MsgDict.Add key:="G165", Item:="SplineBeg"
MsgDict.Add key:="G166", Item:="SplineSpan"
MsgDict.Add key:="G170", Item:="CtlPtTip"
MsgDict.Add key:="G181", Item:="Tab60"
MsgDict.Add key:="G185", Item:="CnnctNamed"
MsgDict.Add key:="G186", Item:="CnnctPtABCD"
MsgDict.Add key:="G187", Item:="CnnctNamedABCD"
MsgDict.Add key:="G193", Item:="PolylineTo"
MsgDict.Add key:="G195", Item:="NURBSTo"
MsgDict.Add key:="G236", Item:="RelCubBezTo"
MsgDict.Add key:="G237", Item:="RelQuadBezTo"
MsgDict.Add key:="G238", Item:="RelMoveTo"
MsgDict.Add key:="G239", Item:="RelLineTo"
End Sub
Function GetMsgName(msgCode As String, MsgNo As Integer) As String
Dim ky As String
ky = msgCode & Trim(str(MsgNo))
If MsgDict.Exists(ky) Then
    GetMsgName = ky & " " & MsgDict(ky)
Else
  GetMsgName = "**<<<Unknown " & ky & ">>**"
  Debug.Print "**<<<Unknown " & ky & ">>**"
End If
End Function

Since I was unsure that the RowTypes were unique or just unique to the section, I prefixed the number with “G” for the Geometry section and “J” for anything new.

Part of the text file produced after the first pass looks like…

<1-1> **<<<Unknown J155>>** nCells=10
<1-1-0/10> **<<<Unknown J155>>**  N=PinX F=4.82813099227 in.
<1-1-1/10> **<<<Unknown J155>>**  N=PinY F=6.7890553653235 in.
<1-1-2/10> **<<<Unknown J155>>**  N=Width F=2.3124999840719 in.
<1-1-3/10> **<<<Unknown J155>>**  N=Height F=2.0781555175781 in.
<1-1-4/10> **<<<Unknown J155>>**  N=LocPinX F=Width*0.5
<1-1-5/10> **<<<Unknown J155>>**  N=LocPinY F=Height*0.5
<1-1-6/10> **<<<Unknown J155>>**  N=Angle F=0 deg.
<1-1-7/10> **<<<Unknown J155>>**  N=FlipX F=FALSE
<1-1-8/10> **<<<Unknown J155>>**  N=FlipY F=FALSE
<1-1-9/10> **<<<Unknown J155>>**  N=ResizeMode F=0
<1-2> **<<<Unknown J133>>** nCells=11
<1-2-0/11> **<<<Unknown J133>>**  N=LineWeight F=THEMEVAL()
<1-2-1/11> **<<<Unknown J133>>**  N=LineColor F=THEMEVAL()
<1-2-2/11> **<<<Unknown J133>>**  N=LinePattern F=THEMEVAL()
<1-2-3/11> **<<<Unknown J133>>**  N=Rounding F=THEMEVAL()
<1-2-4/11> **<<<Unknown J133>>**  N=EndArrowSize F=2
<1-2-5/11> **<<<Unknown J133>>**  N=BeginArrow F=0
<1-2-6/11> **<<<Unknown J133>>**  N=EndArrow F=0
<1-2-7/11> **<<<Unknown J133>>**  N=LineCap F=THEMEVAL()
<1-2-8/11> **<<<Unknown J133>>**  N=BeginArrowSize F=2
<1-2-9/11> **<<<Unknown J133>>**  N=LineColorTrans F=THEMEVAL()
<1-2-10/11> **<<<Unknown J133>>**  N=CompoundType F=3
<1-3> **<<<Unknown J134>>** nCells=17
<10-0> G137 Geometry.1 nCells=6
<10-0/3-0/6>  N=Geometry1.NoFill F=TRUE
<10-0/3-1/6>  N=Geometry1.NoLine F=FALSE
<10-0/3-2/6>  N=Geometry1.NoShow F=FALSE
<10-0/3-3/6>  N=Geometry1.NoSnap F=FALSE
<10-1> G238 RelMoveTo nCells=2
<10-1/3-0/2>  N=Geometry1.X1 F=0.53376659131289
<10-1/3-1/2>  N=Geometry1.Y1 F=0.68418793647153
<11-0> G137 Geometry.2 nCells=6
<11-0/2-0/6>  N=Geometry2.NoFill F=FALSE
<11-0/2-1/6>  N=Geometry2.NoLine F=FALSE
<11-0/2-2/6>  N=Geometry2.NoShow F=FALSE
<11-0/2-3/6>  N=Geometry2.NoSnap F=FALSE

Then it was just a matter of using the report to guess the values.

Next blog will be on finishing the creation of Shapesheet Section shapes from live shapes, including Doc and Page. I have it all worked out and it is not as hard as it looks, but there are some interesting catches.

I hope this helps.

John… Visio MVP in x-aisle
JohnVisioMVP.ca

Published by johnvisiomvp

The original Visio MVP. I have worked with the Visio team since 1993

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out /  Change )

Google photo

You are commenting using your Google account. Log Out /  Change )

Twitter picture

You are commenting using your Twitter account. Log Out /  Change )

Facebook photo

You are commenting using your Facebook account. Log Out /  Change )

Connecting to %s