excel - 如何阻止 Application.OnTime 自身重叠？

Question

我正在编写一个 VBA 代码，它会在需要离开办公室时通知我。

它会从工作簿工作表中获取时间提示我，但当我更新上类时间、午餐时间等时，该值会发生变化。

我创建了一个在某些单元格发生变化时触发的代码，问题是单元格在到达我应该离开的实际时间之前发生了多次变化。因此，我收到的不是一个通知，而是多个通知。

基本上同一个宏会运行多次。当我更改单元格时，如果该宏正在运行，它实际上应该停止它，然后重新启动我的宏。

我用谷歌搜索过，但没有任何帮助。

Sub NotifyMe()
'Declare Variables
    Dim notificationStr, leaveStr As String
    Dim notificationTime As Date
    Dim leaveTime As Date

'Defines now Time
    h = Hour(Now())
    m = Minute(Now())
    s = Second(Now())
    nowtime = TimeSerial(h, m, s)
'Defines the time it will prompt me
    leaveTime = Cells(5, 2).Value
    notificationTime = Cells(5, 2).Value - Cells(6, 2).Value
'Creates a string to be presented in the MsgBox
    notificationStr = Format(notificationTime, "Short Time")
    leaveStr = Format(leaveTime, "Short Time")
    nowStr = Format(nowtime, "short time")
' If it's passed the time, it will notify me
    If nowtime >= notificationTime Then
        Beep
        a = MsgBox("Agora sao " & nowStr & ". E voce tem que sair as " & leaveStr, vbExclamation, "Nao se Atase!")
    Else
        'Schedules the macro to run at the notificationTime
        Application.OnTime EarliestTime:=notificationTime, Procedure:="NotifyMe", Schedule:=True
    End If

End Sub

'Runs NotifyMe everytime a keycell is changed
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim keyCells As Range
    Set keyCells = Range("B1:B8")

    If Not Application.Intersect(keyCells, Range(Target.Address)) Is Nothing Then
        NotifyMe
    End If
End Sub

Answer 1

您可以使用此模式结束预定的 Application.OnTime 事件:

Public notificationTime As Date

Application.OnTime notificationTime, "NotifyMe", Schedule:=False

通过将 notificationTime 设为公共(public)变量，您可以使用它来引用之前安排的完全相同的过程，并使用 Schedule:=False 关闭该过程。

请尝试这个，通常我是最后一个使用 On Error Resume Next 的人，但我认为在这种情况下这是最简单、最可靠的方法。

Option Explicit
Public notificationTime As Date

Sub NotifyMe()
'Declare Variables
    Dim notificationStr, leaveStr As String, a As String
    Dim nowtime As Date, leaveTime As Date, nowStr As Date
    Dim h As Long, m As Long, s As Long

    On Error Resume Next
    Application.OnTime notificationTime, "NotifyMe", Schedule:=False
    On Error GoTo 0

'Defines now Time
    h = Hour(Now())
    m = Minute(Now())
    s = Second(Now())
    nowtime = TimeSerial(h, m, s)
'Defines the time it will prompt me
    leaveTime = Cells(5, 2).Value
    notificationTime = Cells(5, 2).Value - Cells(6, 2).Value
'Creates a string to be presented in the MsgBox
    notificationStr = Format(notificationTime, "Short Time")
    leaveStr = Format(leaveTime, "Short Time")
    nowStr = Format(nowtime, "Short Time")
' If it's passed the time, it will notify me
    If nowtime >= notificationTime Then
        Beep
        a = MsgBox("Agora sao " & nowStr & ". E voce tem que sair as " & leaveStr, vbExclamation, "Nao se Atase!")
    Else
        'Schedules the macro to run at the notificationTime
        Application.OnTime EarliestTime:=notificationTime, Procedure:="NotifyMe", Schedule:=True
    End If

End Sub

此外，在退出此 Excel 工作簿时，如果计划了任务，但其他 Excel 工作簿打开，则该工作簿将在计划时间自动打开并执行代码，除非该任务在关闭工作簿时也被终止。如果您想阻止它，应将以下代码放入 ThisWorkbook 对象的代码中:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
   On Error Resume Next
   Application.OnTime notificationTime, "NotifyMe", Schedule:=False
End Sub