CODEWITHSUNDEEP
vbavisio
Laura
Laura

Reputation: 13

How to get Shape Data with VBA in Visio?

I have been looking for a solution to my problem for 4 hours but have not found anything that works for me. I have a square and added a variable "test" with the value "hello":

Visio Shape

Now I want to read the variable "test" in VBA. For this I first have to see if the variable is present:

Public Sub GetShapeData()
    Dim shpsObj As Visio.Shapes
    Dim shpObj As Visio.Shape

    Set shpsObj = ActivePage.Shapes
    Set shpObj = shpsObj(1)

    Debug.Print shpObj.CellExistsU("Prop.test", 0)
End Sub

I always get 0 as result. Where is the problem?

Upvotes: 1

Views: 8574

Answers (3)

JohnGoldsmith
JohnGoldsmith

Reputation: 2698

If neither CellExists or CellExistsU returns a match then it would suggest the shape you're pointing at does not have the a Shape Data row of that name. If this is the case, then you might find it useful to loop through all of the shapes on the page and check what each one contains. Here's a quick piece of code to help with that:

Public Sub ReportPageShapes()
Dim vPag As Visio.Page
Set vPag = ActivePage

Dim shp As Visio.Shape
For Each shp In vPag.Shapes
    ReportShapeData shp, 0
Next

End Sub

Private Sub ReportShapeData(ByRef shp As Visio.Shape, indent As Integer)
Dim iPropSect As Integer
iPropSect = Visio.VisSectionIndices.visSectionProp

Debug.Print String(indent, Chr(9)) & shp.NameID & " (Index = " & shp.Index & ")"

If shp.SectionExists(iPropSect, Visio.VisExistsFlags.visExistsAnywhere) <> 0 Then
    Dim i As Integer
    For i = 0 To shp.Section(iPropSect).Count - 1 Step 1
        Dim vCell As Visio.Cell
        Set vCell = shp.CellsSRC(iPropSect, i, Visio.VisCellIndices.visCustPropsValue)
        'Could also report vCell.RowName here as well if required
        Debug.Print String(indent, Chr(9)) & Chr(9) & vCell.RowNameU, vCell.ResultStr("")
    Next i
End If

If shp.Shapes.Count > 0 Then
    Dim s As Visio.Shape
    For Each s In shp.Shapes
        ReportShapeData s, indent + 1
    Next
End If

If indent = 0 Then
    Debug.Print vbCrLf
End If

End Sub

This loops through each shape on the page + all child shapes (as they can contains Shape Data too) by recursing or calling the same method on each child.

Upvotes: 4

Surrogate
Surrogate

Reputation: 1734

May be this code can helps 

If shpObj.CellExistsU("Prop.test", 0) then Debug.Print shpObj.Cells("Prop.test").ResultStr("")

Upvotes: 2

Surrogate
Surrogate

Reputation: 1734

Try use use property ResultStr

Debug.Print shpObj.CellExistsU("Prop.test").ResultStr("")

Upvotes: 1

Related Questions