如何实现Visio选中形状时平滑切换至对应ShapeSheet？

原代码的核心问题在于频繁关闭并重建ShapeSheet窗口，这种操作会触发系统级的窗口重绘，而Visio的Application.ScreenUpdating仅能控制绘图页的图形刷新，无法屏蔽窗口创建/销毁带来的界面抖动。

最优解决方案：复用已有ShapeSheet窗口，直接切换显示内容 #

不需要关闭旧窗口，而是找到已打开的ShapeSheet窗口，直接将其显示内容切换为当前选中的形状，彻底避免窗口重建带来的抖动。修正后的代码如下：

Private WithEvents vsoWin As Visio.Window

Private Sub ThisDocument_RunModeEntered(ByRef doc As IVDocument)
    Set vsoWin = ActiveWindow
End Sub

Private Sub vsoWin_SelectionChanged(ByRef win As IVWindow)
    Dim shapeSheetWin As Visio.Window
    Dim targetShape As Visio.Shape
    
    ' 无选中形状时，关闭已打开的ShapeSheet并退出
    If vsoWin.Selection.Count < 1 Then
        For Each shapeSheetWin In Application.Windows
            If shapeSheetWin.SubType = 3 Then
                shapeSheetWin.Close
                Exit For
            End If
        Next
        Exit Sub
    End If
    
    Set targetShape = vsoWin.Selection(1)
    
    ' 查找已打开的ShapeSheet窗口
    Set shapeSheetWin = Nothing
    For Each shapeSheetWin In Application.Windows
        If shapeSheetWin.SubType = 3 Then
            Exit For
        End If
    Next
    
    Application.ScreenUpdating = False
    On Error Resume Next ' 兼容特殊形状（如锁定/组内形状）的异常情况
    If Not shapeSheetWin Is Nothing Then
        ' 直接切换ShapeSheet显示的目标形状，无需重建窗口
        shapeSheetWin.SetSheetObject targetShape.ID, visSheetTypeShape
    Else
        ' 无已打开窗口时，新建ShapeSheet
        targetShape.OpenSheetWindow
    End If
    Application.ScreenUpdating = True
    On Error GoTo 0
End Sub

关键优化点说明 #

• 复用窗口：通过SetSheetObject方法直接修改已有ShapeSheet窗口的显示对象，完全避免窗口关闭/打开的重绘流程
• 错误兼容：增加On Error Resume Next处理特殊形状无法打开ShapeSheet的场景，避免代码崩溃
• 无选中处理：没有选中形状时自动关闭ShapeSheet，保持界面整洁

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