Crystal Rouse
asked on
Visio Grouped Shape Sheet Data
I finally got the below code to work after renaming all the Stencil Shapes. Now, I realize that this only lists the shapes if they are not grouped.
I tested and if I un-group the shape, all the shapes and data will print out to the immediate window.
How do I get to the data for the grouped objects? Once again, thanks for all the excellent help!
Private Sub Document_DocumentSaved(ByV al doc As IVDocument)
'Define the message.
Dim msg, title, style, response
msg = "Do you want to export your Drawing Data?"
title = "Confirm Export"
response = MsgBox(msg, vbYesNo, title)
' Export the Drawing if the answer is Yes
If response = 6 Then
'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.DE SCRIPTION" , visExistsLocally) Then
Set celObj = shpObj.Cells("PROP.DESCRIP TION")
ShapeInfo(1, i - 1) = celObj.ResultStr("")
End If
'Get the Manufacturer property, then get the value as a string.
If shpObj.CellExists("PROP.MF R", 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.PN ", visExistsLocally) Then
Set celObj = shpObj.Cells("PROP.PN")
ShapeInfo(3, i - 1) = celObj.ResultStr("")
End If
'Get the QTY property, then get the value.
If shpObj.CellExists("PROP.QT Y", visExistsLocally) Then
Set celObj = shpObj.Cells("PROP.QTY")
ShapeInfo(4, i - 1) = celObj.ResultStr("")
End If
'Get the REF property, then get the value.
If shpObj.CellExists("PROP.RE F", visExistsLocally) Then
Set celObj = shpObj.Cells("PROP.REF")
ShapeInfo(5, i - 1) = celObj.ResultStr("")
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
Else
Cancel = True
End If
End Sub
I tested and if I un-group the shape, all the shapes and data will print out to the immediate window.
How do I get to the data for the grouped objects? Once again, thanks for all the excellent help!
Private Sub Document_DocumentSaved(ByV
'Define the message.
Dim msg, title, style, response
msg = "Do you want to export your Drawing Data?"
title = "Confirm Export"
response = MsgBox(msg, vbYesNo, title)
' Export the Drawing if the answer is Yes
If response = 6 Then
'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.DE
Set celObj = shpObj.Cells("PROP.DESCRIP
ShapeInfo(1, i - 1) = celObj.ResultStr("")
End If
'Get the Manufacturer property, then get the value as a string.
If shpObj.CellExists("PROP.MF
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.PN
Set celObj = shpObj.Cells("PROP.PN")
ShapeInfo(3, i - 1) = celObj.ResultStr("")
End If
'Get the QTY property, then get the value.
If shpObj.CellExists("PROP.QT
Set celObj = shpObj.Cells("PROP.QTY")
ShapeInfo(4, i - 1) = celObj.ResultStr("")
End If
'Get the REF property, then get the value.
If shpObj.CellExists("PROP.RE
Set celObj = shpObj.Cells("PROP.REF")
ShapeInfo(5, i - 1) = celObj.ResultStr("")
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
Else
Cancel = True
End If
End Sub
SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Can I give a Group a Unique Name or ID? It would be neat if I could export the Group Name and all its shapes and be able to know the Group all the shapes come from. Hope I'm making sense with this question. I want to be able to Group on a Report all the shape data that is related to its Group and use the Group Name as a Title or Header.
Crystal