В VBA, как вызвать определенный метод из неизвестного модуля без Application.Run ()?

Question

Я пытаюсь импровизировать подобный Drupal механизм хука в VBA (продолжайте критиковать, я знаю, это звучит глупо). Причина моих усилий заключается в том, что я не нашел другого способа правильно распределить работу между командами, поэтому с этим механизмом я надеюсь привнести немного проверенной системы вызова крючков в 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 - это Object, который содержит VBComponent, а hook_WorksheetChange() - это фактический Sub, определенный в модуле.

Идеи, пожалуйста? Было бы не слишком элегантно, чтобы каждый хук всегда имел дело с очисткой Application.EnableEvents = True - он должен заниматься только своей, специфичной для функции обработкой ошибок.

Answer 1

Если вы обрабатываете ошибки способом, описанным в этой книге , то с вами все будет в порядке.

В основном Bovey et al. дать каждой подпрограмме точки входа функцию Sub, а каждой подпрограмме точки входа функцию. Все функции возвращают логическое значение, указывающее состояние ошибки. Все ошибки всплывают наверх. Работает очень хорошо.

Единственный вопрос здесь заключался в том, может ли 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