Visio VBA自定义属性访问问题：无法读取Prop.Type属性求助

问题核心 #

你遇到的错误主要有两个原因：

1. 第三方插件添加的自定义属性不一定在默认的Prop命名空间下，可能使用插件专属的前缀（比如User.xxx或插件自定义的命名前缀）；
2. 原代码中直接用pge = "134-1"是错误的，pge是Page对象，必须通过pge.Name来匹配页面名称。

解决步骤 #

1. 确认自定义属性的真实名称

打开Visio选中目标形状，右键选择显示ShapeSheet：

• 查看Prop或User区域的属性列，找到插件添加的属性的内部名称（不是显示名称），比如可能是User.Type而非Prop.Type。

2. 安全访问自定义属性的修正代码

修改宏代码，增加属性存在性校验，避免运行时错误：

Sub Macro4()
    Dim doc As Visio.Document
    Dim pge As Visio.Page
    Dim shp As Visio.Shape
    Dim targetCell As Visio.Cell
       
    For Each doc In Application.Documents
        For Each pge In doc.Pages
            ' 修正：通过Name属性匹配页面
            If pge.Name = "134-1" Then
                For Each shp In pge.Shapes
                    Debug.Print "........* " & shp.Name
                    
                    ' 替换为你在ShapeSheet中找到的真实属性名，比如User.Type
                    On Error Resume Next
                    Set targetCell = shp.CellsU("Prop.Type")
                    On Error GoTo 0
                    
                    If Not targetCell Is Nothing Then
                        Debug.Print "........* 属性值：" & targetCell.ResultStr("")
                        ' 更新属性值示例（注意字符串要加双引号包裹）
                        ' targetCell.FormulaU = """新属性值"""
                    Else
                        Debug.Print "........* 未找到指定自定义属性"
                    End If
                Next shp   
            End If      
       Next pge
    Next doc
End Sub

3. 遍历所有自定义属性（未知属性名时用）

如果不确定属性名称，可以遍历形状的所有自定义属性区域：

Sub ListAllCustomProps()
    Dim shp As Visio.Shape
    Dim i As Integer
    
    ' 示例：选中一个形状后运行，或者替换为遍历页面形状的逻辑
    Set shp = ActiveWindow.Selection(1)
    
    ' 遍历默认自定义属性区域（Prop）
    If shp.SectionExists(visSectionProp, visExistsAnywhere) Then
        Debug.Print "=== 默认自定义属性 ==="
        For i = 0 To shp.Section(visSectionProp).Count - 1
            Debug.Print "属性名：" & shp.CellsSRC(visSectionProp, i, visCustPropsLabel).ResultStr("")
            Debug.Print "属性值：" & shp.CellsSRC(visSectionProp, i, visCustPropsValue).ResultStr("")
        Next i
    End If
    
    ' 遍历用户自定义单元格区域（第三方插件常用）
    If shp.SectionExists(visSectionUser, visExistsAnywhere) Then
        Debug.Print vbCrLf & "=== 用户自定义属性 ==="
        For i = 0 To shp.Section(visSectionUser).Count - 1
            Debug.Print "属性名：" & shp.CellsSRC(visSectionUser, i, visUserValue).NameU
            Debug.Print "属性值：" & shp.CellsSRC(visSectionUser, i, visUserValue).ResultStr("")
        Next i
    End If
End Sub

内容的提问来源于stack exchange，提问作者bailofwZ