Visio拖入形状时如何自动同步形状名为用户输入的形状数据Name值

ShapeSheet无法直接实现形状名称与形状数据字段的自动同步，因为形状的Name属性属于Visio对象模型层面的属性，没有对应的可编辑ShapeSheet单元格支持公式绑定，你可以通过VBA事件触发的方式实现需求，以下是两种可用方案：

方案1：形状数据填写完成后自动同步名称 #

利用ShapeAdded事件，在形状被拖入页面、用户完成形状数据的输入后自动触发同步逻辑，步骤如下：

• 按下Alt+F11打开VBA编辑器，在左侧工程资源管理器中双击ThisDocument模块
• 粘贴以下代码：

Private Sub Document_ShapeAdded(ByVal shp As IVShape)
    On Error Resume Next ' 避免无Prop.Name字段的形状报错
    ' 读取形状数据Name字段的值
    Dim customName As String
    customName = shp.Cells("Prop.Name").ResultStr("")
    If customName <> "" Then
        ' 处理重名情况，避免冲突
        Dim existShp As Shape
        Dim suffix As Integer
        Dim finalName As String
        finalName = customName
        Do
            Set existShp = ActivePage.Shapes(finalName)
            If existShp Is Nothing Then Exit Do
            suffix = suffix + 1
            finalName = customName & "_" & suffix
        Loop
        ' 赋值给形状实际名称
        shp.Name = finalName
        ' 如果需要可以回写处理后的名称到形状数据
        shp.Cells("Prop.Name").FormulaU = Chr(34) & finalName & Chr(34)
    End If
    On Error GoTo 0
End Sub

这段代码会自动识别带Prop.Name字段的形状，在用户完成输入后自动同步值到形状名称，同时自动处理重名问题避免报错。

方案2：拖入形状时直接提示修改名称 #

如果不需要依赖已有的形状数据提示，可以直接通过事件在形状拖入时弹出输入框让用户填写名称，一步到位：

• 同样在ThisDocument模块粘贴以下代码：

Private Sub Document_ShapeAdded(ByVal shp As IVShape)
    ' 可以加判断条件，只针对你自定义的母版形状触发，替换为你实际的母版名称
    If shp.Master Is Nothing Then Exit Sub
    If shp.Master.Name <> "你自定义的母版名称" Then Exit Sub 
    
    Dim inputName As String
    inputName = InputBox("请输入形状名称：", "设置形状名称", shp.Name)
    If inputName <> "" Then
        ' 同样做重名处理
        Dim existShp As Shape
        Dim suffix As Integer
        Dim finalName As String
        finalName = inputName
        Do
            Set existShp = ActivePage.Shapes(finalName)
            If existShp Is Nothing Then Exit Do
            suffix = suffix + 1
            finalName = inputName & "_" & suffix
        Loop
        shp.Name = finalName
        ' 如果需要同步到形状数据Name字段可以加下面这行
        shp.Cells("Prop.Name").FormulaU = Chr(34) & finalName & Chr(34)
    End If
End Sub

使用以上方案后，你后续修改形状Prop.State字段的逻辑可以正常通过自定义名称调用，和你提供的参考代码逻辑完全匹配：

Sub SetStatePassive()
    Dim vPag As Visio.Page
    Set vPag = Visio.ActivePage
    Dim shp As Visio.Shape
    ' 这里直接使用用户自定义的名称调用形状
    Set shp = vPag.Shapes("XV 013A")
    Dim vCell As Visio.Cell
    Set vCell = shp.Cells("Prop.State")
    vCell.FormulaU = Chr(34) & "Passive" & Chr(34)
End Sub

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