Formatting Shape Data in Visio

David Parker

9 years ago

One of the best aspects of Visio is the ability of shapes to hold data, and the easiest way to do this is to define rows of Shape Data. Each row can be defined as holding one of eight different types, and most of these can have their values formatted for display. In this article I discuss the formatting of these values, using either ShapeSheet functions or automation methods. The driver for this is my on-going frustration with the Microsoft provided standard Shape Data window because of its shortcomings … for example, its lack of multi-line support even though it can hold 64k characters in each row, and its lack of a time control, even though it can store dates and time.

I created a simple shape which has at least one example of each type of Shape Data, and applied some sample formatting using the Define Shape Data dialog.

I then inserted a table of each row into the shape, and displayed the Type, Label, actual Value, the Format string, and the formatted value (if applicable).

My intention was to understand if the ShapeSheet FORMAT(…) function could be applied in all cases, and it turns out that t can’t. So, I had to test if a Format actually existed before applying it. Therefore, I inserted a custom formula similar to the following in the fifth column of the table:

=IF(FORMULAEXISTS(Prop.FString.Format),FORMAT(Prop.FString,Prop.FString.Format),Prop.FString)

If I look at the values in the ShapeSheet of my sample shape, then it is clear that the display in the Shape Data window is slightly different in some cases. Look at the Formatted String and Time rows, for example.

So, now if I switch the view the formulas in the ShapeSheet, I can see how the values are represented as formulas:

Thus, it is apparent that the Shape Data window value display is not exactly available from the ShapeSheet direct, so I wrote a VBA method to display the data values exactly how they appear in the Shape Data window:

Type	Label	Format	Value
0	String		This is a normal case sentence
0	Formatted String	@	THIS IS A NORMAL CASE SENTENCE
2	Number		123.45
2	Formatted Number with units	#.#### u	123.45 cm
2	Number fraction with units	# ##/## u	123 9/20 cm
1	Fixed list	;A;B;C;D;E;F	A
4	Variable List	;A;B;C;D;X	X
3	Boolean		TRUE
7	Currency		£123.45
7	Currency System	@	£123.45
7	Currency with unit	U 0.00	£ 123.45
5	Date		24/07/2015
5	Date formatted	{{dd MMM. yy}}	24 Jul. 15
5	Time	{{h:mm:ss am /pm}}	1:21:00 PM
6	Duration		123.4500 ed.
6	Formatted Duration

[h]

:[mm]

123:27

The code to produce the display above (without the tabular grid) is:

Public Sub DisplayData() 
    If Application.ActiveWindow.Selection.Count = 0 Then 
        Exit Sub 
    End If 
Dim shp As Visio.Shape 
    Set shp = Application.ActiveWindow.Selection.PrimaryItem 
    
Dim sect As Integer 
    sect = Visio.VisSectionIndices.visSectionProp 
Dim iRow As Integer 
Dim format As String 
Dim value As String 
Dim dataType As Integer 
Dim toUpper As Boolean 
Dim toLower As Boolean 
Dim label As String 
Dim units As Integer 
Dim txt As String

    txt = "Type" & vbTab & "Label" & vbTab & "Format" & vbTab & "Value" 
    For iRow = 0 To shp.RowCount(sect) - 1 
        If shp.CellsSRC(sect, iRow, _ 
            Visio.VisCellIndices.visCustPropsInvis).ResultIU = 0 Then 
            
            dataType = shp.CellsSRC(sect, iRow, _ 
                Visio.VisCellIndices.visCustPropsType).ResultIU 
            format = shp.CellsSRC(sect, iRow, _ 
                Visio.VisCellIndices.visCustPropsFormat).ResultStr("") 
            label = shp.CellsSRC(sect, iRow, _ 
                Visio.VisCellIndices.visCustPropsLabel).ResultStr("") 
            units = shp.CellsSRC(sect, iRow, _ 
                Visio.VisCellIndices.visCustPropsValue).units 
                
            If Len(format) > 0 Then 
                If dataType = 1 Or dataType = 4 Then 
                    value = shp.CellsSRC(sect, iRow, _ 
                        Visio.VisCellIndices.visCustPropsValue).ResultStr("") 
                ElseIf dataType > 0 Then 
                    value = Application.FormatResult(shp.CellsSRC(sect, iRow, _ 
                            Visio.VisCellIndices.visCustPropsValue).ResultIU, _ 
                        "", units, format) 
                Else 
                    If InStr(format, "+") > 0 Then 
                        toUpper = True 
                    ElseIf InStr(format, "-") > 0 Then 
                        toLower = True 
                    End If 
                    format = Replace(Replace(format, "+", ""), "-", "") 
                    value = Replace(format, "@", _ 
                        shp.CellsSRC(sect, iRow, _ 
                            Visio.VisCellIndices.visCustPropsValue).ResultStr("")) 
                    If toUpper Then 
                        value = UCase(value) 
                    End If 
                    If toLower Then 
                        value = LCase(value) 
                    End If 
                End If 
            Else 
                If dataType = 2 Then 
                    value = CStr(shp.CellsSRC(sect, iRow, _ 
                            Visio.VisCellIndices.visCustPropsValue).ResultIU) 
                Else 
         
;           value = shp.CellsSRC(sect, iRow, _ 
                        Visio.VisCellIndices.visCustPropsValue).ResultStr("") 
                End If 
            End If 
            txt = txt & vbCrLf & dataType & vbTab & label & vbTab & format & vbTab & value 
        End If 
    Next iRow 
    
    Debug.Print txt 
    
End Sub