Visio 中的 VBA：SelectionChanged 事件未触发以将形状置于前面

Question

我一直在 Microsoft Visio 16 中使用 VBA v7.1，以便在选择选定形状时将其带到前层。我已经设置了一个事件处理程序来触发 SelectionChanged 事件，但没有取得任何成功。

这是我当前使用的代码：

Public MyEvents As New MyVisioEvents

Sub InitializeEvents()
    Set MyEvents.vApp = Visio.Application
End Sub

Public WithEvents vApp As Visio.Application

Private Sub vApp_SelectionChanged(ByVal Selection As IVSelection)
    If Not Selection Is Nothing Then
        If Selection.Count > 0 Then
            Dim shape As Visio.shape
            Set shape = Selection.Item(1)
            shape.BringToFront
            Debug.Print "Shape moved to front: " & shape.Name
        End If
    End If
End Sub

最终我想对此进行设置，以便在打开 Visio 文档时调用 InitializeEvents；但是，首先，我希望代码在手动执行 InitializeEvents 时能够正常工作。我收到臭名昭著的错误：“过程声明与同名事件或过程的描述不匹配。”我在许多其他 VBA 帖子中看到此错误，但无法解决我的具体情况。这是我尝试过的调试步骤。到目前为止没有任何帮助。我不断收到同样的错误。

1. 我检查了事件签名，以确保 vApp_SelectionChanged 子例程与 Visio 的 SelectionChanged 事件的预期签名匹配。确实如此。
2. 我上面发布的代码全部在一个模块中；但是，我尝试将事件定义及其处理程序拆分到单独的模块中，以防万一。这没有帮助。
3. 我尝试了“调试”>“编译 VBAProject”，这会引发上述编译时错误。我还使用“运行”>“重置”来清除内存中的所有现有对象。没有帮助。
4. 我在新的 Visio 文档中尝试了代码，以排除实际绘图文档中任何可能的损坏问题。没有帮助。
5. 我将下面所示的代码插入到“ThisDocument”代码窗口中，看看打开绘图时自动运行InitializeEvents是否有任何效果。然后我关闭并重新打开绘图。该代码尝试运行，但产生了与上面提到的相同的编译时错误。

Private Sub Document_DocumentOpened(ByVal doc As IVDocument)
    InitializeEvents
End Sub

6. 为了确保代码没有以某种方式运行，我添加了如下所示的调试打印语句，并再次尝试了步骤 5。调试打印语句未执行。相反，我得到了与所有其他尝试相同的编译时错误。

Private Sub Document_DocumentOpened(ByVal doc As IVDocument)
    Debug.Print "Document opened and InitializeEvents is running."
    InitializeEvents
End Sub

7. 最后，我尝试了Windows 10内置的Visio修复选项。这似乎重新安装了Visio。我正在使用 Visio 2016 Professional，并且必须为此挖掘我的许可证密钥。 “修复过程”成功完成。然后我重复了上面的所有步骤。不幸的是，一切都没有改变。

Answer 1

在我这边，这段代码有效！

Public WithEvents vApp As Visio.Application

Sub InitializeEvents()
    Set vApp = Visio.Application
End Sub
   
Private Sub vApp_SelectionChanged(ByVal Window As IVWindow)
Dim sl As Selection
Set sl = Window.Selection
    If Not sl Is Nothing Then
        If sl.Count > 0 Then
            Dim shape As Visio.shape
            Set shape = sl.Item(1)
            shape.BringToFront
            Debug.Print "Shape moved to front: " & shape.Name
        End If
    End If
Set sl = Nothing
End Sub