如何使用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單元格...

如果你是一個有關使用上的錯誤繼續下一步堅持己見的人，你可以檢查首先檢查是否存在細胞，如果細胞存在：

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