PROSAGA码农传奇-visio-如何在Visio中使用VBA获取Shape数据？

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

作者: 绵绵
发布时间: 2024-08-24 10:43:53 (1月前)
转自：

<div class =“post-text”itemprop =“text”>
  <P>
    如果CellExists或CellExistsU都没有返回匹配，那么它会建议您指向的形状没有该名称的Shape Data行。如果是这种情况，那么您可能会发现遍历页面上的所有形状并检查每个形状包含的内容很有用。这是一段快速的代码来帮助解决这个问题：
  </p>
   <pre>
    <code>
      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

</code>
  </pre>
  <P>
    这通过在每个子节点上递归或调用相同的方法来遍历页面上的每个形状+所有子形状（因为它们也可以包含形状数据）。
  </p>
</DIV>