在VBA中，如何在不使用Application.Run()的情况下从未知模块调用特定方法？

Question

我正在尝试在 VBA 中即兴创作一个类似 Drupal 的钩子机制（继续批评，我知道这听起来很愚蠢）。我努力的原因是我没有找到其他方法可以在团队中正确划分工作，因此我希望通过这种机制引入一些 Drupal 久经考验的钩子调用系统。我已经做到了，效果很好，但有一点缺点。

这就是我所做的：一个调度程序模块，它基本上循环我的项目中的所有模块，并测试它们是否以特定前缀开头（暗示它们是钩子模块），当它找到一个时，它就会这样做这：

Call Application.Run(Module.Name & ".hook_" & HookName)

我知道，这不是很原创，但是如果我循环所有模块并为所有 Workbook 事件调用钩子，它就开始有点像 AOP。这意味着我允许任意数量的模块对 Workbook_SheetChange 进行操作，而不会污染 ThisWorkbook 中的代码。更好的是，不同的人将在不同的钩子模块中处理不同的功能（大好处）。

正如我所说，这是可行的，但我还必须在这些调用之前调用 Application.EnableEvents = False ，并在调用之后调用 Application.EnableEvents = True ，所以我不最终陷入无限调用循环。这也可以。

我的问题：我想在所有钩子之上创建一个通用错误处理程序，这样如果一个钩子搞砸了某些事情，我可以在我的顶级调度程序中捕获错误并重新启用事件。听起来是个好主意，但因为我使用了 Application.Run()，整个错误处理机制在中间被破坏，所以调度程序不会收到钩子内发生的任何错误就是这样调用的。这也会将应用程序事件设置为 False，这很糟糕（请记住，我在调用挂钩之前将它们设置为 False）。

我的问题：有没有一种方法可以在不使用 Application.Run 的情况下调用未知模块内的特定命名函数，这样我的错误就会冒泡到调度程序？我尝试了这个：

Call Module.hook_WorksheetChange()

但它没有编译（我并没有因为它的成功而屏住呼吸，但我希望......）。这里，Module 是一个保存 VBComponent 的 Object，而 hook_WorksheetChange() 是在模块。

请问有什么想法吗？让每个钩子始终处理 Application.EnableEvents = True 清理并不是太优雅 - 它应该只关心它自己的、特定于功能的错误处理。

Answer 1

如果您按照

基本上博维等人。让每个入口点例程成为一个 Sub，每个非入口点例程成为一个 Function。所有函数都返回一个指示错误状态的布尔值。所有错误都会冒泡到顶部。它运作得很好。

这里唯一的问题是 Application.Run 是否可以返回值。我刚刚查了一下，确实可以。

我强烈推荐这本书，但为了完整起见，我将他们推荐的模板放在下面。

希望有帮助。哦，如果您要在 Excel/VBA 中执行复杂的操作，请阅读 他们的书。

入口点例程

Public Sub test()
    Const sSOURCE As String = "test"
    On Error GoTo ErrorHandler

    ' Your code goes here
    If Not Application.Run("YourModule.YourFunction") Then Err.Raise glHANDLED_ERROR
    ' all non-entry routines are called with this If ... Then structure

ErrorExit:
    Exit Sub

ErrorHandler:
    If bCentralErrorHandler(m_sModule, sSOURCE, , True) Then
        Stop
        Resume
    Else
        Resume ErrorExit
    End If
End Sub

非入口点例程

Private Function MyFunction(SomeParameter)

    Const sSOURCE As String = "MyFunction"
    Dim bReturn As Boolean
    bReturn = True
    On Error GoTo ErrorHandler

    ' your code goes here
    MsgBox("something")

ErrorExit:

    MyFunction = bReturn
    Exit Function

ErrorHandler:

    bReturn = False
    If bCentralErrorHandler(m_sModule, sSOURCE) Then
        Stop
        Resume
    Else
        Resume ErrorExit
    End If

End Function

中央错误处理例程

'
' Description:  This module contains the central error
'               handler and related constant declarations.
'
' Authors:      Stephen Bullen, www.oaltd.co.uk
'               Rob Bovey, www.appspro.com
'
' Chapter Change Overview
' Ch#   Comment
' --------------------------------------------------------------
' 12    Initial version
'
Option Explicit
Option Private Module

' **************************************************************
' Global Constant Declarations Follow
' **************************************************************
Public Const gbDEBUG_MODE As Boolean = False    ' True enables debug mode, False disables it.
Public Const glHANDLED_ERROR As Long = 9999     ' Run-time error number for our custom errors.
Public Const glUSER_CANCEL As Long = 18         ' The error number generated when the user cancels program execution.


' **************************************************************
' Module Constant Declarations Follow
' **************************************************************
Private Const msSILENT_ERROR As String = "UserCancel"   ' Used by the central error handler to bail out silently on user cancel.
Private Const msFILE_ERROR_LOG As String = "GHQ_Error.log"  ' The name of the file where error messages will be logged to.


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Comments: This is the central error handling procedure for the
'           program. It logs and displays any run-time errors
'           that occur during program execution.
'
' Arguments:    sModule         The module in which the error occured.
'               sProc           The procedure in which the error occured.
'               sFile           (Optional) For multiple-workbook
'                               projects this is the name of the
'                               workbook in which the error occured.
'               bEntryPoint     (Optional) True if this call is
'                               being made from an entry point
'                               procedure. If so, an error message
'                               will be displayed to the user.
'
' Returns:      Boolean         True if the program is in debug
'                               mode, False if it is not.
'
' Date          Developer       Chap    Action
' --------------------------------------------------------------
' 05/28/04      Rob Bovey       Ch12    Initial version
'
Public Function bCentralErrorHandler( _
            ByVal sModule As String, _
            ByVal sProc As String, _
            Optional ByVal sFile As String, _
            Optional ByVal bEntryPoint As Boolean, _
            Optional bShowDesc As Boolean) As Boolean

    Static sErrMsg As String

    Dim iFile As Integer
    Dim lErrNum As Long
    Dim sFullSource As String
    Dim sPath As String
    Dim sLogText As String

    ' Grab the error info before it's cleared by
    ' On Error Resume Next below.
    lErrNum = Err.Number
    ' If this is a user cancel, set the silent error flag
    ' message. This will cause the error to be ignored.
    If lErrNum = glUSER_CANCEL Then sErrMsg = msSILENT_ERROR
    ' If this is the originating error, the static error
    ' message variable will be empty. In that case, store
    ' the originating error message in the static variable.
    If Len(sErrMsg) = 0 Or bShowDesc Then sErrMsg = Err.description
    If Erl > 0 Then sErrMsg = sErrMsg & " at line " & Erl

    ' We cannot allow errors in the central error handler.
    On Error Resume Next

    ' Load the default filename if required.
    If Len(sFile) = 0 Then sFile = ThisWorkbook.name

    ' Get the gxlapp directory.
    sPath = ThisWorkbook.Path
    If Right$(sPath, 1) <> "\" Then sPath = sPath & "\"

    ' Construct the fully-qualified error source name.
    sFullSource = "[" & sFile & "]" & sModule & "." & sProc

    ' Create the error text to be logged.
    sLogText = "  " & sFullSource & ", Error " & _
                        CStr(lErrNum) & ": " & sErrMsg & IIf(Erl > 0, ". Line: " & Erl, "")

    ' Open the log file, write out the error information and
    ' close the log file.
    iFile = FreeFile()
    Open sPath & msFILE_ERROR_LOG For Append As #iFile
    Print #iFile, Format$(Now(), "mm/dd/yy hh:mm:ss"); sLogText
    If bEntryPoint Then Print #iFile,
    Close #iFile

    ' Do not display or debug silent errors.
    If sErrMsg <> msSILENT_ERROR Then

        ' Show the error message when we reach the entry point
        ' procedure or immediately if we are in debug mode.
        If bEntryPoint Or gbDEBUG_MODE Then
            gxlApp.ScreenUpdating = True
            MsgBox sErrMsg
            DoEvents
            ' Clear the static error message variable once
            ' we've reached the entry point so that we're ready
            ' to handle the next error.
            sErrMsg = vbNullString
        End If

        ' The return vale is the debug mode status.
        bCentralErrorHandler = gbDEBUG_MODE

    Else
        ' If this is a silent error, clear the static error
        ' message variable when we reach the entry point.
        If bEntryPoint Then sErrMsg = vbNullString
        bCentralErrorHandler = False
    End If

End Function