vba - VBA を使用して Visio カスタム図形情報を取得する方法

Question

VBA を使用して、Visio 2003 ダイアグラムからカスタム シェイプ情報を取得する方法を教えてください。

Answer 1

Visio 図形からカスタム図形情報を取得するには:

Function GetCustomPropertyValue(TheShape As Visio.Shape, ThePropertyName As String) As String
    On Error Resume Next
    GetCustomPropertyValue = TheShape.CellsU("Prop." & ThePropertyName).ResultStr(visNone)
End Function

この関数が行うことは、形状の cellsu プロパティを使用して、カスタム プロパティ ShapeSheet セルを名前で取得することだけです...

次に on error resume を使用することに固執している場合は、最初にセルが存在するかどうかを確認することで、セルが存在するかどうかを確認できます。

if TheShape.CellExistsU( "Prop." & ThePropertyName , 0 ) then
GetCustomPropertyValue = TheShape.CellsU("Prop." & THePropertyName).ResultStr(VisNone)

Answer 2

http://visio.mvps.org/VBA.htm (カスタム プロパティ)でこれを見つけました

Public Sub CustomProp()
    Dim shpObj As Visio.Shape, celObj As Visio.Cell
    Dim i As Integer, j As Integer, ShpNo As Integer
    Dim LabelName As String, PromptName As String, ValName As String, Tabchr As String

    Open "C:\CustomProp.txt" For Output Shared As #1

    Tabchr = Chr(9)

    For ShpNo = 1 To Visio.ActivePage.Shapes.Count
        Set shpObj = Visio.ActivePage.Shapes(ShpNo)
        nRows = shpObj.RowCount(Visio.visSectionProp)
        For i = 0 To nRows - 1
            Set celObj = shpObj.CellsSRC(Visio.visSectionProp, i, 0)
            ValName = celObj.ResultStr(Visio.visNone)
            Set celObj = shpObj.CellsSRC(Visio.visSectionProp, i, 1)
            PromptName = celObj.ResultStr(Visio.visNone)
            Set celObj = shpObj.CellsSRC(Visio.visSectionProp, i, 2)
            LabelName = celObj.ResultStr(Visio.visNone)

            Debug.Print shpObj.Name, LabelName, PromptName, ValName
            Print #1, shpObj.Name; Tabchr; LabelName; Tabchr; PromptName; Tabchr; ValName
        Next i
    Next ShpNo

    Close #1
End Sub