Excel VBA中Err.Raise遇错误18时End按钮无限循环问题

问题现象 #

优化VBA错误处理时发现：当用户按Esc触发**运行时错误18（用户中断）**后，在模式1、2的错误处理逻辑中重新抛出错误，点击错误对话框的「End」按钮会导致对话框无限重复弹出；但模式3、4、5及其他类型错误（如除零错误）无此问题。

底层机制解析 #

错误18是VBA中特殊的用户中断类错误，和普通运行时错误的触发与处理逻辑存在差异：

• 当Application.EnableCancelKey = xlErrorHandler时，Esc触发的中断会被转为错误18进入自定义错误处理流程，而非直接终止程序。
• 错误18的上下文带有“用户中断请求”的标记，若在错误处理中直接重新抛出该错误，且未重置中断状态，点击「End」按钮时，VBA的错误处理栈无法正确清理中断标记，会再次触发错误18，形成循环。
• 调用子过程（如示例中的cleanup）可能间接干扰错误处理上下文的状态，尤其是当子过程修改了Application.EnableCancelKey设置时，会加剧这个循环问题。

各模式差异原因 #

• 模式1、2：直接重新抛出错误18，且调用了cleanup（修改了中断设置），错误上下文的中断标记未被清除，导致「End」按钮触发循环。
• 模式3：重新抛出错误前设置Application.EnableCancelKey = xlInterrupt，重置了中断处理模式，清除了错误18的特殊标记，「End」按钮可正常终止程序。
• 模式4：未调用cleanup，错误上下文未被额外干扰，重新抛出错误时系统能正确处理「End」操作。
• 模式5：对错误18单独处理，不重新抛出，而是用MsgBox提示后直接退出，避免了循环触发。

解决方案 #

针对错误18的特殊处理需求，推荐以下两种方式：

1. 单独捕获处理：如模式5，判断错误编号为18时，直接给出用户提示，不重新抛出错误：

   If (errNum = 18) Then
       MsgBox "代码被用户中断"
   ElseIf (errNum <> 0) Then
       Err.Raise errNum, , descr
   End If
   

2. 重置中断模式：在重新抛出错误前，先重置Application.EnableCancelKey为默认值xlInterrupt，清除中断标记：

   Application.EnableCancelKey = xlInterrupt
   If (Err.Number <> 0) Then
       Err.Raise Err.Number, , Err.Description
   End If
   

测试代码 #

Option Explicit
Public Sub test()
    Application.EnableCancelKey = xlErrorHandler
    On Error GoTo test_cleanup
#If True Then
    '按Esc键直到代码中断
    Dim i As Integer, ti As Date
    ti = TimeValue("00:00:01")
    For i = 1 To 1000
        Application.StatusBar = "迭代 #" & Format(i, "000")
        Application.Wait (Now + ti)
    Next i
#Else
    ' 强制触发除零错误
    Dim x As Integer: x = 1 / 0
#End If

    Err.Clear
test_cleanup:

#Const codePattern = 1
#If codePattern = 1 Then
    '"End"按钮在Esc错误时无限循环，除零错误则正常
    '执行不重置错误的清理操作
    cleanup
    '结束清理
    If (Err.Number <> 0) Then
        Err.Raise Err.Number, , Err.Description
    End If

#ElseIf codePattern = 2 Then
    Dim errNum As Long, descr As String: errNum = Err.Number: descr = Err.Description
    '"End"按钮在Esc错误时无限循环，除零错误则正常
    '执行一系列清理操作，示例中会清除错误（实际清理中可能发生）
    On Error GoTo 0
    cleanup
    '结束清理
    If (errNum <> 0) Then
        Err.Raise errNum, , descr
    End If

#ElseIf codePattern = 3 Then
    '"End"按钮正常工作
    '执行不重置错误的清理操作
    '示例代码，注释后仍能正常工作
    Application.EnableCancelKey = xlInterrupt
    '结束清理
    If (Err.Number <> 0) Then
        Err.Raise Err.Number, , Err.Description
    End If

#ElseIf codePattern = 4 Then
    '"End"按钮正常工作
    Dim errNum As Long, descr As String: errNum = Err.Number: descr = Err.Description
    '执行一系列清理操作，示例中会清除错误（实际清理中可能发生）
    'Debug.Print Err.Number
    On Error GoTo 0
    'Debug.Print Err.Number
    '结束清理
    If (errNum <> 0) Then
        Err.Raise errNum, , descr
    End If

#ElseIf codePattern = 5 Then
    '"End"按钮正常工作
    Dim errNum As Long, descr As String: errNum = Err.Number: descr = Err.Description
    '执行可能重置或不重置错误的清理操作
    On Error GoTo 0
    cleanup
    '结束清理
    If (errNum = 18) Then
        MsgBox "代码被用户中断"
    ElseIf (errNum <> 0) Then
        Err.Raise errNum, , descr
    End If

#End If    
End Sub

Private Sub cleanup()
    '该行不影响问题，仅作示例
    Application.EnableCancelKey = xlInterrupt
End Sub

内容的提问来源于stack exchange，提问作者David I. McIntosh