Visio Shapesheet中CALLTHIS触发不稳定：多形状同时删除异常

问题场景 #

我做了个用于视听原理图的Visio宏模具，里面有个19英寸机架形状：

• 默认1U高度，拖拽可扩展至47U（行业常用最大规格）
• 每个U位旁带编号标记（小方块），通过Shapesheet公式控制显隐，这部分功能正常
• 为避免删除机架主体后残留标记，给每个标记的Shapesheet自定义单元格添加公式，当机架主体被删除时，调用VBA的DeleteMe子程序删除自身

当前实现 #

Shapesheet公式 #

=IFERROR(IF(RackBody!Width>20 mm,TRUE,TRUE),CALLTHIS("ThisDocument.DeleteMe","AV_Symbols_24"))

VBA删除代码 #

Sub DeleteMe(vsoShp as Visio.Shape)
    vsoShp.Delete
End Sub

遇到的问题 #

删除机架主体时，仅ID最小的前65个标记会被成功删除；若将vsoShp.Delete注释掉换成Debug.Print，所有94个标记都会触发输出。推测是逐个删除形状的操作耗时，导致后续标记的触发被Visio跳过，目前只能将机架高度限制为27U以保证稳定。

可行解决方案 #

方案1：批量删除（推荐） #

放弃让每个标记单独触发删除，改为在机架主体被删除时，一次性查找并删除所有关联标记：

1. 在文档级添加形状删除事件判断：

Private Sub Document_ShapeDelete(ByVal shp As Visio.Shape)
    ' 判断被删除的是否为机架主体（根据实际主控名调整）
    If shp.Master.Name = "RackBody" Then
        Dim page As Visio.Page
        Set page = shp.Page
        
        Dim targetShp As Visio.Shape
        ' 遍历页面，删除所有机架标记（根据标记主控名调整）
        For Each targetShp In page.Shapes
            If targetShp.Master.Name = "RackU_Label" Then
                ' 若页面存在多个机架，可通过标记自定义属性关联机架ID，避免误删
                targetShp.Delete
            End If
        Next
    End If
End Sub

2. 移除所有标记Shapesheet中的CALLTHIS公式，避免逻辑冲突

方案2：先收集再批量删除 #

如果保留Shapesheet触发逻辑，可先将需删除的标记存入集合，等所有触发完成后统一删除：

1. 在模块中声明集合存储待删除标记：

Private m_toDelete As Collection

' 文档关闭时清空集合
Private Sub Document_BeforeDocumentClose(Cancel As Boolean)
    Set m_toDelete = Nothing
End Sub

2. 修改DeleteMe子程序，仅将标记加入集合：

Sub DeleteMe(vsoShp As Visio.Shape)
    If m_toDelete Is Nothing Then
        Set m_toDelete = New Collection
    End If
    ' 以形状ID为Key避免重复添加
    On Error Resume Next
    m_toDelete.Add vsoShp, Key:=CStr(vsoShp.ID)
    On Error GoTo 0
End Sub

3. 添加页面变更事件，批量删除集合中的标记：

Private Sub Document_ShapeChanged(ByVal shp As Visio.Shape)
    If Not m_toDelete Is Nothing And m_toDelete.Count > 0 Then
        Dim shpToDel As Visio.Shape
        ' 循环删除集合内所有标记，避免索引混乱
        Do While m_toDelete.Count > 0
            Set shpToDel = m_toDelete(1)
            m_toDelete.Remove 1
            If Not shpToDel Is Nothing Then
                shpToDel.Delete
            End If
        Loop
        Set m_toDelete = Nothing
    End If
End Sub

方案3：优化Shapesheet触发逻辑 #

将原公式改为直接判断机架主体是否存在，逻辑更简洁，但需配合方案2的批量删除才能解决遗漏问题：

=IF(EXISTS(RackBody),TRUE,CALLTHIS("ThisDocument.DeleteMe","AV_Symbols_24"))

问题原因 #

Visio按形状ID顺序处理Shapesheet触发的VBA调用，逐个删除形状会导致页面形状集合动态变化，后续标记的触发可能因上下文变更被中断。批量删除或延迟处理可避免此问题，确保所有关联标记被清理。

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