5

Using VBA, how do I retrieve custom shape information from a Visio 2003 diagram.

warren
  • 32,620
  • 21
  • 85
  • 124
JonnyGold
  • 861
  • 6
  • 15
  • 20

2 Answers2

5

To get custom shape information from a Visio shape:

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

All this function does is uses the cellsu property on a shape to get the custom property ShapeSheet cell by name...

If you're a stickler about using the on error resume next, you can check to see if the cell exists by first checking if the cell exists:

if TheShape.CellExistsU( "Prop." & ThePropertyName , 0 ) then
GetCustomPropertyValue = TheShape.CellsU("Prop." & THePropertyName).ResultStr(VisNone)
Jon Fournier
  • 4,299
  • 3
  • 33
  • 43
  • `CellExistsU` returns an integer according to [the documentation](https://msdn.microsoft.com/en-us/vba/visio-vba/articles/shape-cellexistsu-property-visio). Are you sure it can be used as a boolean (0 for false, nonzero for true)? – jpmc26 Feb 22 '18 at 22:30
  • yes I'm sure, the documentation doesn't really say what's returned but I've used it many times as a boolean. – Jon Fournier Feb 26 '18 at 19:43
3

Found this, at http://visio.mvps.org/VBA.htm (Custom Properties)

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
jpmc26
  • 28,463
  • 14
  • 94
  • 146
Geej
  • 31
  • 2