• Visio Show Shape Data

Recently i needed to write a macro that processes an MS Visio 2007 page and and does some actions based on the contents of a custom defined stencil shapes, where this contents are saved as a Shape Data field in the shape the problem was i wanted to access the Shape Data of each shape.

I need to export Shape Data in a Drawing (on an event still to be determined) to a text or Excel File. I can do this using the Reports. I want to use VBA to export the data instead. I have the following which doesn't seem to work. I'm not getting to the Shape Data. This will print the Name to the Immediate Window,
Private Sub Document_DocumentSaved(ByVal doc As IVDocument)
'Visio Page object
Dim pagObj As Visio.Page
'Visio Shapes collection
Dim shpsObj As Visio.Shapes
'Visio Shape object
Dim shpObj As Visio.Shape
'Visio Cell object
Dim celObj As Visio.Cell
'Array to hold purchase order info
Dim ShapeInfo() As String
'Counter
Dim iShapeCount As Integer
'Counter
Dim i As Integer
'Get the active page.
Set pagObj = ActivePage
'Get the Shapes collection of the page.
Set shpsObj = pagObj.Shapes
'Total number of shapes.
iShapeCount = shpsObj.Count
'Set the array size to hold all of the shape information.
ReDim ShapeInfo(5, iShapeCount - 1)
'For each shape on the page, collect the Name, Description,
'Manufacturer, Part Number, Ref Data and Quantity.
For i = 1 To iShapeCount
'Get the i'th shape.
Set shpObj = shpsObj(i)
'Get the shape name.
ShapeInfo(0, i - 1) = shpObj.Name
'Get the Description property, then get the value as a string.
If shpObj.CellExists('Prop.Description', visExistsLocally) Then
Set celObj = shpObj.Cells('Prop.Description')

Visio Show Shape Data

ShapeInfo(1, i - 1) = celObj.ResultStr(')
End If
'Get the Manufacturer property, then get the value as a string.
If shpObj.CellExists('Prop.MFR', visExistsLocally) Then
Set celObj = shpObj.Cells('Prop.MFR')
ShapeInfo(2, i - 1) = celObj.ResultStr(')
End If
'Get the Part Number property, then get the value as a string.
If shpObj.CellExists('Prop.MFR P/N', visExistsLocally) Then
Set celObj = shpObj.Cells('Prop.MFR P/N')
ShapeInfo(3, i - 1) = celObj.ResultStr(')
End If
'Get the Ref Number property, then get the value.
If shpObj.CellExists('Prop.REF DATA', visExistsLocally) Then
Set celObj = shpObj.Cells('Prop.REF DATA')
ShapeInfo(4, i - 1) = celObj.ResultIU
End If
'Get the Quantity property, then get the value.
If shpObj.CellExists('Prop.QTY', visExistsLocally) Then
Set celObj = shpObj.Cells('Prop.QTY')
ShapeInfo(5, i - 1) = celObj.ResultIU
End If
'Release Shape object.
Set shpObj = Nothing
Next
'Print to Immediate window to verify data collection.
For i = 0 To pagObj.Shapes.Count - 1
Debug.Print ShapeInfo(0, i) & ';' _
& ShapeInfo(1, i) & vbTab _
& ShapeInfo(2, i) & vbTab _
& ShapeInfo(3, i) & vbTab _
& ShapeInfo(4, i) & vbTab _
& ShapeInfo(5, i)
Next
End Sub