如何在excel VBA中检查或取消MULTIPLE挂起的application.ontime事件?

goo*_*ogy 8 excel ontime vba

我正在使用Application.Ontime事件从单元格中提取时间字段,并安排子程序在此时运行.我的Application.Ontime事件在Workbook_BeforeSave事件上运行.因此,如果用户(更改所需时间+保存工作簿)多次,则会创建多个Application.Ontime事件.从理论上讲,我可以使用唯一的时间变量跟踪每个事件..但有没有办法检查/解析/取消待处理事件?

Private Sub Workbook_BeforeSave
    SendTime = Sheets("Email").Range("B9")
    Application.OnTime SendTime, "SendEmail"
End Sub

Private Sub Workbook_BeforeClose
    Application.OnTime SendTime, "SendEmail", , False
End Sub
Run Code Online (Sandbox Code Playgroud)

因此,如果我:
将B9更改为12:01,将工作簿
更改为B9保存到12:03,将工作簿
更改B9保存到12:05,将工作簿
更改B9保存到12:07,保存工作簿

我最终解雇了多个事件.我只想要一场比赛(最近一场比赛)

如何在Workbook_BeforeClose事件中取消所有挂起事件(或至少枚举它们)?

Nic*_*zer 3

我不认为你可以迭代所有待处理的事件或一次性取消它们。我建议设置一个模块级别或全局布尔值来指示是否触发您的事件。所以你最终会得到这样的结果:

Dim m_AllowSendMailEvent As Boolean
Sub SendMail()
If Not m_AllowSendMailEvent Then Exit Sub

'fire event here

End Sub
Run Code Online (Sandbox Code Playgroud)

编辑:

将其添加到工作表模块的顶部,该模块包含包含您要查找的日期/时间值的范围:

' Most recently scheduled OnTime event. (Module level variable.)
Dim PendingEventDate As Date

' Indicates whether an event has been set. (Module level variable.)
Dim EventSet As Boolean

Private Sub Worksheet_Change(ByVal Target As Range)

Dim SendTimeRange As Range

' Change to your range.
Set SendTimeRange = Me.Range("B9")

' If the range that was changed is the same as that which holds
' your date/time field, schedule an OnTime event.
If Target = SendTimeRange Then

    ' If an event has previously been set AND that time has not yet been
    ' reached, cancel it. (OnTime will fail if the EarliestTime parameter has
    ' already elapsed.)
    If EventSet And Now > PendingEventDate Then

        ' Cancel the event.
        Application.OnTime PendingEventDate, "SendEmail", , False

    End If

    ' Store the new scheduled OnTime event.
    PendingEventDate = SendTimeRange.Value

    ' Set the new event.
    Application.OnTime PendingEventDate, "SendEmail"

    ' Indicate that an event has been set.
    EventSet = True

End If

End Sub
Run Code Online (Sandbox Code Playgroud)

这是一个标准模块:

Sub SendEmail()

    'add your proc here

End Sub
Run Code Online (Sandbox Code Playgroud)