切换工作簿后Worksheet.Change事件代码停止运行的问题求助

工作表通过Worksheet_Change事件监听D10、D19单元格的下拉框选择，触发对应行的隐藏/取消隐藏操作。填写完成点击提交后，内容会写入另一个独立文件并自动保存关闭，但提交完成激活原工作表后，Change宏不再生效，必须关闭并重新打开工作簿才能恢复，怀疑是切换工作簿导致事件触发异常。

当前Worksheet_Change事件代码如下：

Private Sub Worksheet_Change(ByVal Target As Range)

Application.EnableEvents = True


    If Not Intersect(Target, Range("D10")) Is Nothing Then
        'On Error Resume Next
         Application.ScreenUpdating = False

        Select Case Range("D10")
            Case "SELECT...": HideAllROws
            Case "LEARNING": Hide
            Case "LISTENING": Hide
        End Select
        
        Call CLEARBOTTOMOPTIONS
    End If


    If Not Intersect(Target, Range("D19")) Is Nothing Then
        'On Error Resume Next
         Application.ScreenUpdating = False

        Select Case Range("D19")
            Case "SELECT…": Hide
            Case "Payments": PaymentROws
            Case "VT": VtsRows
            Case "Procedure": ProceedureRows
            Case "Complaint": ComplaintRows
            Case "Incorrect Info Given": IncorrectInfoRows
            Case "FAIL": PaymentROws
            Case "PASS": PassRows
        End Select
    End If
    

             Application.ScreenUpdating = True
             
    End Sub

核心原因 #

大概率是提交代码中修改了Application.EnableEvents但未恢复，或者当前Change事件代码缺乏错误捕获机制，导致执行出错时事件监听状态未正常重置。

解决方案1：为Worksheet_Change添加错误捕获 #

修改事件代码，确保无论是否发生错误，都能恢复ScreenUpdating和EnableEvents的初始状态：

Private Sub Worksheet_Change(ByVal Target As Range)
    ' 保存全局参数初始状态
    Dim originalEvents As Boolean
    Dim originalScreenUpdating As Boolean
    originalEvents = Application.EnableEvents
    originalScreenUpdating = Application.ScreenUpdating
    
    On Error GoTo Cleanup ' 捕获错误，跳转到清理步骤

    Application.EnableEvents = True
    Application.ScreenUpdating = False

    If Not Intersect(Target, Range("D10")) Is Nothing Then
        Select Case Range("D10")
            Case "SELECT...": HideAllROws
            Case "LEARNING": Hide
            Case "LISTENING": Hide
        End Select
        Call CLEARBOTTOMOPTIONS
    End If

    If Not Intersect(Target, Range("D19")) Is Nothing Then
        Select Case Range("D19")
            Case "SELECT…": Hide
            Case "Payments": PaymentROws
            Case "VT": VtsRows
            Case "Procedure": ProceedureRows
            Case "Complaint": ComplaintRows
            Case "Incorrect Info Given": IncorrectInfoRows
            Case "FAIL": PaymentROws
            Case "PASS": PassRows
        End Select
    End If

Cleanup:
    ' 恢复初始状态
    Application.ScreenUpdating = originalScreenUpdating
    Application.EnableEvents = originalEvents
    ' 可选：抛出错误提示
    If Err.Number <> 0 Then
        MsgBox "执行出错: " & Err.Description, vbExclamation
        Err.Clear
    End If
End Sub

解决方案2：修正提交代码的事件状态处理 #

打开处理提交逻辑的代码，确保操作另一个工作簿前后，正确设置并恢复EnableEvents：

Sub SubmitData()
    Dim originalEvents As Boolean
    originalEvents = Application.EnableEvents
    
    On Error GoTo SubmitCleanup

    Application.EnableEvents = False ' 防止操作外部文件时触发不必要事件
    
    ' 此处保留你原有的提交逻辑：打开目标文件、写入数据、保存关闭
    ' ... 你的现有代码 ...

SubmitCleanup:
    Application.EnableEvents = originalEvents ' 必须恢复事件监听状态
    If Err.Number <> 0 Then
        MsgBox "提交出错: " & Err.Description, vbExclamation
        Err.Clear
    End If
End Sub

额外检查点 #

• 确认HideAllROws、PaymentROws等自定义子过程中，没有修改Application.EnableEvents且未恢复。
• 排查是否有其他宏或插件在操作过程中修改了全局事件监听状态。

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