我正在尝试在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的Object
,hook_WorksheetChange()
是模块中定义的实际Sub
。
想法,好吗?让每个钩子始终处理Application.EnableEvents = True
清理并不太优雅 - 它应该只关注它自己的,特定于功能的错误处理。
答案 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