Comment puis-je récupérer des informations de forme Visio personnalisé avec VBA

Question

Utilisation de VBA, comment puis-je récupérer forme personnalisée d'informations à partir d'un diagramme Visio 2003.

Answer 1

Pour obtenir la forme personnalisée des informations à partir d'une forme 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

Toute cette fonction n'est utilise la propriété cellsu sur une forme pour obtenir la cellule ShapeSheet de propriété personnalisée par nom ...

Si vous êtes pointilleux sur l'utilisation du CV sur d'erreur suivante, vous pouvez vérifier si la cellule existe en vérifiant d'abord si la cellule existe:

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

Answer 2

Nous avons trouvé ce, à http://visio.mvps.org/VBA.htm (Propriétés personnalisées)

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