1

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

有人可以启发我吗?

根据要求发布代码!

这是在工作表模块中:

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
4

2 回答 2

0

我进行了一系列实验,试图更好地理解这个函数,我的结果如下。我很高兴确认@Jean-François Corbett(此处)提供的有根据的假设是绝对正确的。

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

为了回应@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 Class 模块之间提供串扰:

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

(在制作此代码时没有真正的狗受到伤害)

于 2013-11-22T16:29:09.883 回答
0

它不是必需的,而且它是一种非常骇人听闻的代码编写方式。在极少数情况下“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
于 2016-09-07T21:51:34.583 回答