Question

4个小时以来，我一直在寻找解决问题的方法，但没有找到适合我的方法。我有一个正方形，并添加了一个值为“ hello”的变量“ test”：

现在，我想在VBA中读取变量“ test”。为此，我首先必须查看变量是否存在：

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

我总是得到0。问题出在哪里？

Answer 1

如果CellExists或CellExistsU均未返回匹配项，则表明您所指向的形状没有该名称的Shape Data行。如果是这种情况，那么您可能会发现遍历页面上的所有形状并检查每个形状包含的内容很有用。以下是一段简短的代码可以帮助您解决这个问题：

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

这通过在每个子对象上递归或调用相同的方法来循环遍历页面上的每个形状+所有子形状（因为它们也可以包含Shape Data）。

Answer 2

尝试使用use属性ResultStr

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

Answer 3

也许这段代码可以帮助

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

如何在Visio中使用VBA获取形状数据？

3 个答案: