Application.OnTime on Error Resume Next

Question

我想知道为什么onTime方法需要在on Error Resume next Statement之前。显然它是因为它引发了一个错误而且似乎没有影响它的功能，但我只是好奇。

任何人都可以启发我吗？

根据要求发布代码！

这是在工作表模块中：

Const scrollRowName = "WindowScrollRow"
Dim ws As DataViewSheetClass
Public nextTime As Double
Public latestTime As Double


Private Sub startDog()
If Me.ProtectContents Then
    nextTime = Now + TimeSerial(0, 0, 3)
    If Me.ProtectContents Then Application.OnTime nextTime, Me.CodeName & ".kickDog"
End If
End Sub

Private Sub kickDog()
Static prevWsRow As Long

    If Me Is ActiveSheet And Me.ProtectContents Then
        wsRow = ActiveWindow.scrollRow
        If wsRow <> prevWsRow Then
            With Application
              .screenUpdating = False
              .StatusBar = "Calculating Formats"
              .EnableEvents = False

              scrollRow.Value2 = ActiveWindow.scrollRow

              .EnableEvents = True
              .StatusBar = False

              prevWsRow = wsRow
              .screenUpdating = True
            End With
        End If

        Debug.Print timeStamp & ": Woof!" & Chr(9) & wsRow & Chr(9) & scrollRow.Value2

        nextTime = Now + TimeSerial(0, 0, 3)
        latestTime = nextTime + TimeSerial(0, 0, 10)
        Application.OnTime nextTime, Me.CodeName & ".kickDog", latestTime
    Else
        killDog
    End If
End Sub

Private Sub killDog()
    On Error GoTo rebootObjects
    scrollRow.Value2 = 1
    On Error Resume Next
    Application.OnTime nextTime, Me.CodeName & ".Worksheet_Deactivate", latestTime, False
    On Error GoTo 0
    Exit Sub
rebootObjects:
    Set scrollRow = Me.Range(scrollRowName)
    scrollRow.Value2 = 1
    Resume Next
End Sub

Private Sub Worksheet_Activate()
    Debug.Print timeStamp & ": " & "Summary Activate Start:" & Chr(9) & MicroTimer - t
    t = MicroTimer
    On Error GoTo enableAndExit
    Set ws = New DataViewSheetClass
    Application.EnableEvents = False
    With ws
        .addedActiveArea = Range("WeeksTable")
        .addedActiveArea = Range("SummaryTotals")
        .SparkTargetBehaviour = HEAVY
    End With

enableAndExit:
    Err.Clear
    Application.EnableEvents = True
    Set scrollRow = Me.Range(scrollRowName)
    Set volatileRange = Me.Range(volatileRangeName)
    startDog
    Debug.Print timeStamp & ": " & "Summary Activated:" & Chr(9) & MicroTimer - t
    t = MicroTimer
End Sub

Private Sub Worksheet_Deactivate()
    killDog        
    Set ws = Nothing
End Sub

Answer 1

我进行了一系列实验，试图更好地理解这个功能，我的结果如下。我很高兴地确认@ Jean-FrançoisCorbett（here）提供的受过教育的假设绝对正确。

1. 是的，您可以拥有多个具有相同完全相同EarliestTime的计时器，因此该参数不等同于“注册计时器的序列号”（与我在别处阅读相反）。
2. 您可以使用不同的 Procedure参数调用相同的 EarliestTime参数，它也可以正常运行为两个独立的计时器。< / LI>
3. 然而，这两个参数在杀死计时器时都必须与初始调用（使用Schedule:=True）相同（使用Schedule:=False）。如果不这样做，将会ERROR: 1004: Application-defined or object-defined error尝试使用Schedule:=False执行OnTime调用。此外，在这种情况下，定时器不会被重置，如果在定时器触发时无法解析回叫过程地址，将导致ERROR 1004: Object variable or With block variable not set。
4. 计时器的分辨率为1秒。如果您尝试相隔0.5秒启动两个计时器，它们将以相同的开始时间进行注册。
5. 我认为使用LatestTime参数并不明智：我认为应该始终手动终止计时器。省略它还可以确保如果存在超过计时器持续时间的长保存或计算事件并且延迟回叫，则计时器将持续存在。
6. 完全限定回调Procedure非常重要，以确保在计时器触发时它可以解析。如果没有这样做，可能会导致计时器无法重置，如果其他工作簿当时打开，则工作簿会在尝试关闭时重新打开。
7. 可以使用引用OnTimer Class Module Procedure Worksheet的回叫Class Module来创建Method。确保Procedure参数完全合格（例如Procedure:="'wb Name.xlsm'!Sheet1.methodName"）是个好主意。
8. 如果您使用Worksheet_Activate和Worksheet_Deactivate事件来管理计时器生命周期并从Workbook_WindowActivate和Workbook_WindowDeactivate事件调用这些过程，那么计时器将可靠地启动并且工作簿将关闭并保持关闭。您还可以使用Workbook_BeforeClose和Workbook_Open事件，但它们不会涵盖工作簿之间的切换。由于它们触发的顺序，窗口事件与工作表事件一起将涵盖所有内容。
9. 您需要使用某些方法将这些事件传输到托管计时器的活动工作表。这可以通过基于Class创建CallByName来通知ActiveSheet工作簿事件来完成。您也可以使用WorkBook中声明的WithEvents，Class Worksheet对象来执行此操作，但仍需要CallByName类型调用才能启动WorkBook_WindowActivate 1}}。
10. 在计时器触发后尝试使用OnTime Schedule:=False 终止计时器将导致ERROR: 1004: Application-defined or object-defined error。
11. 使用On Error Resume Next进行OnTime Schedule:=False调用之前允许在触发后终止计时器。我这样做，但我总是捕获错误，我没有看到OnTime函数抛出的任何错误，这些错误不是真正的，需要处理。

为了回应Mr Gary先生所表达的兴趣，我提供了例子，工作代码。

在ThisWorkbook课程模块中：

Option Explicit
Dim Notify As New cActiveSheetBus

'This is needed to boot the active sheet because the
'Worksheet_Activate event does not fire in the sheet
Private Sub Workbook_WindowActivate(ByVal Wn As Window)
    Notify.onWindowActivate ActiveSheet
End Sub

一个名为cActiveSheetBus的类，用于在WorkBook和Worksheet类模块之间提供串扰：

Option Explicit
Const moduleIndent = 2
'Notify Activesheet of Workbook Events
Sub activeSheetCallBack(ws As Worksheet, cb As String)

    On Error GoTo fnCallbackFailed
    CallByName ws, cb, VbMethod
    On Error GoTo 0
    Exit Sub
fnCallbackFailed:
    Debug.Print cModuleName & vbTab & myName & vbTab & "****failed****"
    Err.Clear
End Sub

Public Sub onOpen(ws As Worksheet)
    activeSheetCallBack ws, "onOpen"
End Sub
Public Sub beforeClose(ws As Worksheet)
    activeSheetCallBack ws, "beforeClose"
End Sub
Public Sub beforeSave(ws As Worksheet)
    activeSheetCallBack ws, "beforeSave"
End Sub
Public Sub afterSave(ws As Worksheet)
    activeSheetCallBack ws, "afterSave"
End Sub
Public Sub onWindowActivate(ws As Worksheet)
    activeSheetCallBack ws, "onWindowActivate"
End Sub
Public Sub onWindowDEActivate(ws As Worksheet)
    activeSheetCallBack ws, "onWindowDEActivate"
End Sub

在主机工作表的类模块（在本例中为Sheet2）

Option Explicit

Const cPulseTime As Long = 1
Const cBackgroundPulse As Boolean = False
Dim mOnTime As cOnTime

'Expose custom worksheet properties to configure the timer (optional)
Property Get pulseTime() As Long
  ' Can put any logic here that interracts with the sheet
  ' or the user or the application for example
  '  pulseTime = cPulseTime
    pulseTime = Me.Range("pulseTime")
End Property
Property Get enableBackgroundPulse() As Boolean
    enableBackgroundPulse = cBackgroundPulse
End Property
Property Get designMode() As Boolean
    designMode = Me.ProtectContents
End Property

'****************************************
'ActiveSheet Call-backs
Public Sub onWindowActivate()
Const cMyName As String = "onWindowActivate"

  Worksheet_Activate

End Sub
'****************************************

'****************************************
'Timer call-back for cOnTime
Public Sub kickDog()
'   Code to execute on timer event
'******************************************
    On Error Resume Next
    Me.Cells(1, 1) = Not Me.Cells(1, 1)
    On Error GoTo 0
'******************************************
    Debug.Print "woof!!"
    On Error GoTo exitError
        mOnTime.kickDog
    On Error GoTo 0
Exit Sub
exitError:
End Sub

Private Sub Worksheet_Activate()
Const myName As String = "Sheet2.Worksheet_Activate"
    Debug.Print myName

    If (mOnTime Is Nothing) Then
      Set mOnTime = New cOnTime
    Else
      mOnTime.kickDog
    End If
End Sub

Private Sub Worksheet_Deactivate()
Const pName As String = "Sheet2.Worksheet_Deactivate"

End Sub

这在一个名为cOnTime的类模块中：

Option Explicit
'****************************************
'Encapsulated timer that will sense the active
' sheet and expect to find a callback there
'
'In host sheet
' Const cPulseTime As Long = 1
'
' Dim mOnTime As cOnTime
' Property Get PulseTime() As Long
'     PulseTime = cPulseTime
' End Property
' '****************************************
' 'Timer call-back for cOnTime
' Public Sub kickDog()
' '   Code to execute on timer event
' '******************************************
'     On Error Resume Next
'     Me.Cells(1, 1) = Not Me.Cells(1, 1)
'     On Error GoTo 0
' '******************************************
'     Debug.Print "woof!!"
'     On Error GoTo exitError
'         mOnTime.kickDog
'     On Error GoTo 0
' Exit Sub
' exitError:
' End Sub

Const DEFDoWhen As String = "kickDog"
Const DEFPulseTime = "PulseTime"
Const DEFearliestTime As Long = 5
Const DEFlatestTime As Long = 15

Private WithEvents wb As Workbook
Private Ws As Worksheet

Private DoWhen As String
Dim KillTimer As String
Private mPulseTime As Long
Private mDesignMode
Private mBackgroundPulse
Private mNextTime As Double
Property Let callBackDoWhen(cb As String)
    DoWhen = "'" & wb.Name & "'!" & Ws.CodeName & "." & cb      'e.g. 'wb Name.xlsm'!Sheet1.kickdog
End Property
Property Let callBackPulseTime(csPulseTime As String)
Const cMyName As String = "Let PulseTime"

    On Error Resume Next
         mPulseTime = CallByName(Ws, csPulseTime, VbGet)
         If Err.Number <> 0 Then
             mPulseTime = DEFearliestTime
         End If
    On Error GoTo 0

End Property
Private Function wsGetProperty(prop As String, default)
    On Error Resume Next
         wsGetProperty = CallByName(Ws, prop, VbGet)
         If Err.Number <> 0 Then
             wsGetProperty = default
         End If
    On Error GoTo 0
End Function
Private Function pulseTime() As Long
' This is a live connection to the sheet
    pulseTime = wsGetProperty(DEFPulseTime, DEFearliestTime)
End Function
Private Function designMode() As Boolean
' The sheet is only consulted once
  If mDesignMode = Empty Then _
    mDesignMode = wsGetProperty("designMode", False)
  designMode = mDesignMode
End Function
Private Function backgroundPulse() As Boolean
' The sheet is only consulted once
  If mBackgroundPulse = Empty Then _
    mBackgroundPulse = wsGetProperty("enableBackgroundPulse", False)
  backgroundPulse = mBackgroundPulse
End Function
Public Sub kickDog()
Const myName As String = "kickDog"
Dim psMessage As String
    If (Ws Is ActiveSheet Or backgroundPulse) _
        And Not designMode Then

        mNextTime = Now + TimeSerial(0, 0, pulseTime)

        On Error Resume Next
        Application.OnTime mNextTime, DoWhen
        On Error GoTo 0
    End If
    Exit Sub
End Sub
Public Sub killDog()

    If Ws Is Nothing Or mNextTime = 0 Then Exit Sub

    On Error Resume Next
    Application.OnTime mNextTime, DoWhen, , False
    On Error GoTo 0

End Sub
Private Sub Class_Initialize()
Dim errorContext As String

Debug.Print "init conTime"

    On Error GoTo enableAndExit
        Set wb = ActiveWorkbook
        Set Ws = ActiveSheet
    On Error GoTo 0

    callBackDoWhen = DEFDoWhen
    callBackPulseTime = DEFPulseTime
    pulseTime
    designMode
    backgroundPulse

    kickDog

    Exit Sub
enableAndExit:
    If Err <> 0 Then
        If Ws Is Nothing Then
            errorContext = "ws"
        ElseIf wb Is Nothing Then
            errorContext = "wb"
        End If
    End If
End Sub

Private Sub Class_Terminate()
Const myName As String = "Class_Terminate"

    On Error Resume Next
    killDog
    Set Ws = Nothing
    Set wb = Nothing
    Exit Sub

End Sub

' Manage the timer in response to workbook events
' If the timer is not killed it may cause the workbook
' to reopen after it is closed when the timer calls back.

Private Sub wb_WindowActivate(ByVal Wn As Window)
Const myName As String = "cOnTime.wb_WindowActivate"
    Debug.Print myName

   ' this is handled by ThisWorkbook
End Sub

Private Sub wb_WindowDeactivate(ByVal Wn As Window)
Const myName As String = "cOnTime.wb_WindowDeactivate"
    Debug.Print myName

    If Not backgroundPulse Then killDog
End Sub
Private Sub wb_BeforeClose(Cancel As Boolean)
Const myName As String = "cOnTime.wb_BeforeClose"
    Debug.Print myName

    killDog
End Sub

Private Sub wb_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Const myName As String = "cOnTime.wb_BeforeSave"
    Debug.Print myName

    If SaveAsUI Then killDog
End Sub

（在制作此代码时，没有真正的狗受伤）

Answer 2

它不是必需的，而且编写代码是一种可怕的hacky方式。 很少有情况可以接受“On Error Resume Next”。 这里有两个要考虑：

Public function Example1() as Boolean
   dim blnReturnValue as Boolean

   On error goto errHandler

     ... Do stuff here that might error
     ... All code can error!

     blnReturnValue = True  ' Set return flag to success

   cleanExit:
      On Error Resume Next  ' <-- Only Place where "On Error Resume Next" is acceptable
      ... Finalise things here, close objects etc. 

      Example1 = blnReturnValue   ' Return the result

      Exit Function  ' Single Exit point
   errHandler:
      ... Handle the error appropriately here

      Resume CleanExit    ' Ensure the function cleans up after itself
End Function

或者，如果您预计会出现错误，但必须继续：

Public function Example2() as Boolean
   dim blnReturnValue as Boolean

   On Error Goto errHandler

       blnReturnValue = True  ' default return flag to success

       ... Execute error prone code here
       ... This line will still run after returning from the error handler

       Example2 = blnReturnValue ' Will be False if an error occurred, otherwise true
       Exit Function   'Single Exit Point
   errHandler:
       blnReturnValue = False  ' Set return flag to Failure
       msgbox err.description
       Resume Next   ' Resume at the next line after the error occurred 

End Function