在VBA中,如何在没有Application.Run()的情况下从未知模块调用特定方法?

时间:2012-01-15 21:54:39

标签: excel drupal vba hook aop

我正在尝试在VBA中即兴创建类似Drupal的钩子机制(继续批评,我知道这听起来很愚蠢)。我努力的原因是我没有找到任何其他方法在团队中正确划分工作,因此我希望通过这种机制带来一些Drupal尝试过的钩子调用系统。我做到了,效果很好,但我有一点缺点。

这就是我所做的:一个调度程序模块,它基本上遍历我项目中的所有模块,并测试它们是否以特定前缀开头(提示它们是钩子模块),以及何时找到一个,它这样做:

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

不是很原创,我知道,但如果我遍历所有模块并调用所有Workbook事件的挂钩,它就会开始闻起来像AOP。这意味着我允许任意数量的模块作用于Workbook_SheetChange,而不会污染ThisWorkbook中的代码。更好的是,不同的人将在不同的钩子模块(BIG BONUS)内工作不同的功能。

正如我所说,这是有效的,但我必须在这些调用之前调用Application.EnableEvents = False,并在调用之后调用Application.EnableEvents = True,所以我不会在无限调用循环中结束。这也没关系。

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

我的问题:有没有办法在没有Application.Run的情况下在未知模块中调用特定命名的函数,所以我的错误会冒泡到调度程序?我试过这个:

Call Module.hook_WorksheetChange()

但它没有编译(我没有屏住呼吸它的成功,但我希望......)。此处,Module是保存VBComponent的Objecthook_WorksheetChange()是模块中定义的实际Sub

想法,好吗?让每个钩子始终处理Application.EnableEvents = True清理并不太优雅 - 它应该只关注它自己的,特定于功能的错误处理。

1 个答案:

答案 0 :(得分:3)

如果您按照this book中描述的方式进行错误处理,那么您应该没问题。

基本上Bovey等人。给每个入口点例程一个Sub和每个非入口点例程一个Function。所有函数都返回一个指示错误状态的布尔值。所有错误都浮出水面。它运作得很好。

这里唯一的问题是Application.Run是否可以返回值。我刚检查过,它可以。

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

希望有所帮助。哦,如果你要在Excel / VBA中做复杂的事情,请阅读their book

入口点例程

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