如何使用 VBA 检索 Visio 自定义形状信息
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/507409/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
How do I retrieve Visio custom shape information with VBA
提问by JonnyGold
Using VBA, how do I retrieve custom shape information from a Visio 2003 diagram.
使用 VBA，如何从 Visio 2003 图表中检索自定义形状信息。
采纳答案by Jon Fournier
To get custom shape information from a Visio shape:
从 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
All this function does is uses the cellsu property on a shape to get the custom property ShapeSheet cell by name...
这个函数所做的就是使用形状上的 cellsu 属性来按名称获取自定义属性 ShapeSheet 单元格...
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:
如果您是接下来使用 on error resume 的坚持者，您可以通过首先检查单元格是否存在来检查单元格是否存在：
if TheShape.CellExistsU( "Prop." & ThePropertyName , 0 ) then
GetCustomPropertyValue = TheShape.CellsU("Prop." & THePropertyName).ResultStr(VisNone)
回答by Geej
Found this, at http://visio.mvps.org/VBA.htm(Custom Properties)
在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
