如何在代码中为Application.OnTime事件创建一个停止?

时间:2014-05-16 14:49:25

标签: excel vba excel-vba

我在这里有一些代码完全有效,除了当我尝试关闭Excel工作表时。我已经尝试将计时器编程为在我关闭工作簿时停止但它似乎没有工作。每当我关闭工作簿时,它都会自动重新打开。任何有关调整我的代码的帮助都会非常感激。这是:

第1单元中的代码:

    Dim RT1 As Date
    Dim Lunch As Date
    Dim ApT As Date
    Dim RT3 As Date
    Dim NextTick As Date

    Public Sub UpdateTime()
    ' Places a bug fix for stopping the clock when closing the workbook
    Debug.Print "UpdateTime" & Format(RunWhen, "00:00:00")
    ' Updates cell D8 with the Current time
    ThisWorkbook.Sheets(1).Range("D8") = Now()
    ' Set up next event 1 second from now
    NextTick = Now + TimeValue("00:00:01")
    Application.OnTime NextTick, "UpdateTime"
    End Sub

    Public Sub StopClock()
    ' Cancels the OnTime event
    On Error Resume Next
    Application.OnTime NextTick, "UpdateTime", , False
    End Sub

第2单元中的代码:

    Sub PhoneHours()
    'Time left at the beginning of the day
    If Range("B12") < Range("A3") Then Range("E12").FormulaR1C1 = "=(R[3]C[-3]-R[0]C[-3])-        (2*R[0]C[1])"
    'Time left after the first Research Time Has passed
    If Range("B12") >= Range("A3") Then Range("E12").FormulaR1C1 = "=(R[3]C[-3]-R[0]C[-3])-        (1.75*R[0]C[1])"
    'Time left after Lunch and Second Research Time
    If Range("B12") >= Range("B3") Then Range("E12").FormulaR1C1 = "=(R[3]C[-3]-R[0]C[-3])-        (0.5*R[0]C[1])"
    'Time left afetr Apple Time
    If Range("B12") >= Range("D3") Then Range("E12").FormulaR1C1 = "=(R[3]C[-3]-R[0]C[-3])-        (0.25*R[0]C[1])"
    'Time left after Final Research Time
    If Range("B12") >= Range("E3") Then Range("E12").FormulaR1C1 = "=(R[3]C[-3]-R[0]C[-3])"

    NextCheck = Now + TimeValue("00:00:10")
    Application.OnTime NextCheck, "PhoneHours"

    End Sub

    Sub StopCheck()
    ' Cancels the OnTime event
    On Error Resume Next
    Application.OnTime NextCheck, "PhoneHours", , False
    End Sub

ThisWorkbook中的代码:

    Sub Worksheet_Deactivate()
    Call StopClock
    Call StopCheck
    End Sub

    Sub Workbook_Activate()
    Call UpdateTime
    Call PhoneHours
    End Sub

    Sub Workbook_Open()
    Call UpdateTime
    Call PhoneHours
    End Sub

    Sub Workbook_Close()
    Call StopClock
    Call StopCheck
    End Sub

提前致谢!

1 个答案:

答案 0 :(得分:0)

当我尝试做类似的事情时,我发现主要的问题是OnTime调用的引发频率远高于我的预期 - 如果你在PhoneHours子中放置一个debug.print,那么你会看到这种情况这里。您的StopCheck例程仅取消最近的呼叫,但所有早期的呼叫仍处于活动状态(并且导致在关闭后重新打开该书)。

您可能想要创建一些断点/调试,以确切地找出每个被调用的位置和原因,以便使您的工作表更有效地运行,但无论如何我发现取消所有未来准时的最可靠方法调用是一种分散的方法,如下所示:

Sub StopCheck()
    ' Cancels the OnTime event
    Debug.Print "Cancelled Phonehours"
    On Error Resume Next
    ' Cancels all OnTime events scheduled in the next 15 seconds
    For i = 0 To 15
        Application.OnTime Now + TimeValue("00:00:" & i), "PhoneHours", , False
    Next i
    On Error GoTo 0
End Sub

Public Sub StopClock()
    ' Cancels the OnTime event
    On Error Resume Next
    Debug.Print "Cancelled UpdateTime"
    ' Cancels all OnTime events scheduled in the next 3 seconds
    For i = 0 To 3
        Application.OnTime Now + TimeValue("00:00:" & i), "UpdateTime", , False
    Next i
    On Error GoTo 0
End Sub

这应该不会留下未来的OnTimes计划,您应该能够成功关闭工作表。

(顺便提一下,你的Worksheet_Deactivate应该是Workbook_Deactivate吗?)

相关问题