Word中ContentControlOnExit事件陷入无限循环问题求助

我在MS Word中创建了一份规范模板，具备在表格中插入下拉列表的功能，列表会自动填充规范的参考文献（文档名称+存储路径）。用户从列表选中文档并点击其他位置后，脚本会在表格另一单元格插入链接，方便用户打开参考文档。该功能正常运行一年多，但自系统从Win10升级到Win11并安装Office更新后，插入链接后脚本陷入无限循环：光标本该停留在用户点击的位置，却反复选中链接所在单元格的起始位置及单元格范围。添加断点分步运行时功能正常，无断点则卡住。代码未做修改，相关代码如下：

事件处理代码 #

Private Sub Document_ContentControlOnExit(ByVal dropDown As contentcontrol, Cancel As Boolean)
    Dim myTable As Table
    Dim rowID As Long
    Dim index As Integer
    Dim content As String
        
    If InStr(dropDown.Tag, "procedureDropDown") > 0 Then
        dropDown.Range.Select
        Set myTable = Selection.Tables(1)
        rowID = Selection.Cells(1).RowIndex
        
        For index = 1 To dropDown.DropdownListEntries.Count
            If dropDown.DropdownListEntries(index).Text = dropDown.Range.Text Then
                myTable.Cell(rowID, myTable.Columns.Count - 3).Select
                Selection.Text = "Link to the procedure"
                
                ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, address:=dropDown.DropdownListEntries(index).Value
                Exit Sub
                
            End If
        Next index
        
    End If

End Sub

光标跟踪代码 #

Option Explicit

Public WithEvents positionTracker As Word.Application
Public currentPosition As Range
Public previousPosition As Range

Private Sub positionTracker_WindowSelectionChange(ByVal newSelection As Selection)
    If Not currentPosition Is Nothing Then
        Set previousPosition = currentPosition
    End If
    
    Set currentPosition = newSelection.Range
End Sub

1. Office更新后的事件触发逻辑变更：Win11搭配新版Office时，Hyperlinks.Add操作会触发WindowSelectionChange事件，而光标跟踪代码会更新位置变量；同时Document_ContentControlOnExit中多次使用Select方法，进一步触发选择变化事件，形成循环链。
2. 无断点时事件触发频率过高：分步调试时，断点会中断事件触发链，避免循环；无断点时事件触发速度极快，导致WindowSelectionChange与内容控件退出事件、选择操作互相触发，陷入死循环。
3. 依赖Selection对象的副作用：代码中频繁使用Select方法强制改变选择状态，在新版Office中这类操作更容易触发额外的选择变化事件，加剧循环问题。

方法1：临时禁用事件触发 #

在修改内容和添加链接的过程中，禁用Word的事件触发，切断循环链：

Private Sub Document_ContentControlOnExit(ByVal dropDown As contentcontrol, Cancel As Boolean)
    Dim myTable As Table
    Dim rowID As Long
    Dim index As Integer
    Dim targetCell As Range
        
    If InStr(dropDown.Tag, "procedureDropDown") > 0 Then
        ' 禁用事件，避免操作触发额外事件
        Application.EnableEvents = False
        
        ' 直接通过dropDown获取表格，避免依赖Selection
        Set myTable = dropDown.Range.Tables(1)
        rowID = dropDown.Range.Cells(1).RowIndex
        
        For index = 1 To dropDown.DropdownListEntries.Count
            If dropDown.DropdownListEntries(index).Text = dropDown.Range.Text Then
                Set targetCell = myTable.Cell(rowID, myTable.Columns.Count - 3).Range
                targetCell.Text = "Link to the procedure"
                
                ' 调整锚点范围，避免链接覆盖整个单元格
                targetCell.MoveEnd wdCharacter, -1
                ActiveDocument.Hyperlinks.Add Anchor:=targetCell, address:=dropDown.DropdownListEntries(index).Value
                
                ' 恢复光标到用户原操作位置
                dropDown.Range.Next.Select
                
                Exit For
            End If
        Next index
        
        ' 恢复事件触发
        Application.EnableEvents = True
    End If
End Sub

方法2：优化光标跟踪代码，过滤脚本操作 #

添加状态标记，跳过脚本操作导致的位置更新：

Option Explicit

Public WithEvents positionTracker As Word.Application
Public currentPosition As Range
Public previousPosition As Range
Public isProcessing As Boolean ' 标记是否正在执行脚本操作

Private Sub positionTracker_WindowSelectionChange(ByVal newSelection As Selection)
    ' 脚本处理期间跳过位置更新
    If isProcessing Then Exit Sub
    
    If Not currentPosition Is Nothing Then
        Set previousPosition = currentPosition.Duplicate ' 复制对象避免引用冲突
    End If
    
    Set currentPosition = newSelection.Range.Duplicate
End Sub

同时在事件处理代码中设置标记：

Private Sub Document_ContentControlOnExit(ByVal dropDown As contentcontrol, Cancel As Boolean)
    Dim myTable As Table
    Dim rowID As Long
    Dim index As Integer
    Dim targetCell As Range
        
    If InStr(dropDown.Tag, "procedureDropDown") > 0 Then
        isProcessing = True ' 标记开始处理
        
        Set myTable = dropDown.Range.Tables(1)
        rowID = dropDown.Range.Cells(1).RowIndex
        
        For index = 1 To dropDown.DropdownListEntries.Count
            If dropDown.DropdownListEntries(index).Text = dropDown.Range.Text Then
                Set targetCell = myTable.Cell(rowID, myTable.Columns.Count - 3).Range
                targetCell.Text = "Link to the procedure"
                
                targetCell.MoveEnd wdCharacter, -1
                ActiveDocument.Hyperlinks.Add Anchor:=targetCell, address:=dropDown.DropdownListEntries(index).Value
                
                dropDown.Range.Next.Select
                
                Exit For
            End If
        Next index
        
        isProcessing = False ' 标记处理结束
    End If
End Sub

方法3：移除对Selection的依赖 #

全程使用Range对象操作，避免触发选择变化事件，从根源减少事件触发：
核心是删除所有.Select调用，直接通过Range对象修改内容和添加链接，彻底避免选择状态变化引发的事件。

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