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.
John… Visio MVP in x-aisle
JohnVisioMVP.ca
john Visio MVP 