I need an OED

I have enhanced the Visio stencil shapes so that each shape has custom properties (AKA Shape Data) that is pulled down to the various cells in the shape. I have also updated how the Control Handles that control the width of the cells work.

So,I now have a stencil of Visio section shapes that I can connect to Excel. The next step is to gt information from a Visio shape to fill in the stencil shapes. This is relatively easy because the heart of the shapesheet is an Excel structure that can be accessed by CellsSrc(). Though it could be considered CellsSource, it actually stands for Cells-Section-Row-Cell. So, if you give it values between 0-FF, you get the contents of that cell. This is a bit simplified, but that is the basics. Not all cells are filled, so there is SectionExists(), RowExists() and CellsSRCExists to make sure there is content there. Though I did have issues with CellsSrcExists that disageed with RowsCellCount(). So, it was relatively easy, if you have Graham Wideman’s roadmap to the shapesheet.

One issue is that Visio is big on enuration, so the extracted information, is just numbers, though there is text in the formuls and values. So, how do you translate numbers to text, a dictionary. This is how the dictionary is created.

Sub LoadDictionary()
Set MsgDict = Nothing
Set MsgDict = CreateObject("Scripting.Dictionary")
MsgDict.Add key:="Geo000", Item:="Default"
MsgDict.Add key:="Geo088", Item:="Tab0"
MsgDict.Add key:="Geo089", Item:="Component"
MsgDict.Add key:="Geo08A", Item:="MoveTo"
MsgDict.Add key:="Geo08B", Item:="LineTo"
MsgDict.Add key:="Geo08C", Item:="ArcTo"
MsgDict.Add key:="Geo08D", Item:="InfiniteLine"
MsgDict.Add key:="Geo08F", Item:="Ellipse"
MsgDict.Add key:="Geo090", Item:="EllipticalArcTo"

MsgDict.Add key:="SctO016", Item:="Group"
MsgDict.Add key:="SctO017", Item:="Shape Layout"
MsgDict.Add key:="SctO018", Item:="Page Layout"
MsgDict.Add key:="SctO019", Item:="Print Properties"
End Sub

This is how it is accessed.

Function GetMsgName(MSgName As String, MsgNo As Integer) As String
 Dim ky As String
 ky = MSgName & Right("00000" & Hex(MsgNo), 3)
 If MsgDict.Exists(ky) Then
     GetMsgName = MsgDict(ky)
 Else
   GetMsgName = "<<" & ky & "Unknown>>"
 End If
 End Function

Rather than a dictionary for each enumeration list, I used one list with header text and the enumeration value.

Of course, how did I create the list? Docs.Microsoft.com have the enumeration lists and it was just a matter of screenscraping the list into Excel and a little cleanup. (Since the Docs.Microsoft,com lists are alphabetically sorted by name, I had done this before to have it sorted numrically by value.) In Excel, prefixes, but as a seperate column. So once the table was populated, it could be sorted. An extra column was added that used Excel formulas to combine the various column in the form of the MsgDict.Add statements shown above. So, any maintenance to the list is just a matter of adding the new rows to Excel, sorting and cut and paste to VBA.

To save space, the numbers are converted to hex. Since Docs.Microsoft.com knows these values as integers, the conversion to hex is done in the formala that builds the VBA statement.

To make life easier, the cells in the shapesheet are numbered in Excel like Format, A01,A02… B01,B02…

The second issue is that there is no mapping between CellsSRC and the location in the spreadsheet. That was relatively easy, though slightly time consuming. I have an Excel sheet that has one row per cell sorted by section. and another that maps enumerations to text. So, with dual screens, it was easy to go through the shapesheet worksheet look up the enumeration value and fill it to the cell where the value should be displayed. Again, this cell reference is in Excel like format.

John… Visio MVP in x-aisle
JohnVisioMVP.ca