我进行了一系列实验,试图更好地理解这个函数,我的结果如下。我很高兴确认@Jean-François Corbett(此处)提供的有根据的假设是绝对正确的。
- 是的,您可以拥有多个完全相同的计时器,
EarliestTime
因此此参数不等同于“注册计时器的序列号”(与我在其他地方的阅读相反)。
- 您可以在具有不同
Procedure
参数的调用中使用相同 EarliestTime
的参数,它也可以作为两个单独的计时器正常运行。
- 然而,这两个参数必须与
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
如果在定时器触发时无法解析回调过程地址,则会产生错误。
- 计时器的分辨率为 1 秒。如果您尝试以 0.5 秒的间隔启动两个计时器,它们将使用相同的开始时间进行注册。
- 我不认为使用这个
LatestTime
参数是明智的:我认为计时器应该总是手动终止。省略它还可以确保如果存在超过计时器持续时间的长保存或计算事件并延迟回调,则计时器将持续存在。
- 完全限定回调
Procedure
以确保它在计时器触发时可解析非常重要。如果其他工作簿当时打开,否则可能会导致计时器未重新设置,并且工作簿在尝试关闭它时重新打开。
- 可以创建一个带有引用 a
OnTimer Class Module
的回调。确保参数是完全限定的(例如)是个好主意。Procedure
Worksheet
Class Module
Method
Procedure
Procedure:="'wb Name.xlsm'!Sheet1.methodName"
- 如果您使用
Worksheet_Activate
和Worksheet_Deactivate
事件来管理计时器生命周期并从 Workbook_WindowActivate 和 Workbook_WindowDeactivate 事件中调用这些过程,则计时器将可靠地启动并且工作簿将关闭并保持关闭状态。您还可以使用 Workbook_BeforeClose 和 Workbook_Open 事件,但它们不会涵盖工作簿之间的切换。由于它们触发的顺序,窗口事件连同工作表事件将涵盖所有内容。
- 您需要使用一些方法将这些事件传输到托管计时器的活动工作表。这可以通过创建一个
Class
, 基于CallByName
通知ActiveSheet
工作簿事件来完成。您也可以使用在中声明WorkBook
的WithEvents
Class
对象来执行此操作Worksheet
,但您仍然需要CallByName
类型调用来启动WorkBook_WindowActivate
。
OnTime Schedule:=False
在计时器触发后尝试终止计时器将导致ERROR: 1004: Application-defined or object-defined error
.
- 在
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
(在制作此代码时没有真正的狗受到伤害)