Как проверить или отменить несколько ожидающих событий application.ontime в Excel VBA? - PullRequest
Новая
       42

Как проверить или отменить несколько ожидающих событий application.ontime в Excel VBA?

8 голосов
/ 05 января 2011

Я использую событие 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

Так что, если я:
изменить B9 на 12:01, сохранить рабочую книгу
изменить B9 на 12:03, сохранить рабочую книгу
изменить B9 на 12:05, сохранить рабочую книгу
изменить B9 на 12:07, сохранить рабочую книгу
и т. Д.

Я получаю несколько событий.Я хочу, чтобы ОДНО событие было запущено (последнее запланированное событие)

Как я могу отменить ВСЕ ожидающие события (или перечислить их как минимум) для события Workbook_BeforeClose?

Ответы [ 4 ]

3 голосов
/ 05 января 2011

Не думаю, что вы можете перебирать все ожидающие события или отменять их все в одном шабанге. Я бы предложил установить уровень модуля или глобальное логическое значение, указывающее, следует ли запускать ваше событие. Таким образом, вы получите что-то вроде этого: 

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

'fire event here

End Sub

Edit:

Добавьте это в ТОП модуля листа, который содержит диапазон, который содержит значение даты / времени, после которого вы: 

' 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

И это для стандартного модуля: 

Sub SendEmail()

    'add your proc here

End Sub
1 голос
/ 15 ноября 2011

или вы можете просто создать какую-нибудь ячейку (например, счеты), например:

, если я использую application.ontime: 

if range("V1") < 1 then

    Application.OnTime dTime, "MyMacro"

    range("V1")=range("V1") + 1

 end if

, если я хочу прекратить считать ... 

   Application.OnTime dTime, "MyMacro", , False

   range("V1")=range("V1") - 1
1 голос
/ 10 января 2011

Я думаю, что у меня может быть решение, которое работает, основываясь на некоторых советах, которые уже даны.

Короче говоря, мы создаем глобальный массив, и каждый раз, когда пользователь нажимает save, SendTime записывается в массив. Это служит для отслеживания всех наших запланированных времен.

Когда рабочая книга закрыта, мы перебираем массив и удаляем все запланированные времена.

Я проверил это, и, похоже, он работал в Excel 2003. Дайте мне знать, как вы поживаете. 

Dim scheduleArray() As String //Set as global array to hold times

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

Private Sub Workbook_BeforeClose
    On Error Resume Next
    Dim iArr As Integer, startTime As String

    For iArr = 0 To UBound(scheduleArray) - 1 //Loop through array and delete any existing scheduled actions 
        startTime = scheduleArray(iArr)
        Application.OnTime TimeValue(startTime), "SendEmail", , False
    Next iArr
End Sub

Sub AddToScheduleArray(startTime As String)
    Dim arrLength As Integer

    If Len(Join(scheduleArray)) < 1 Then
        arrLength = 0
    Else
        arrLength = UBound(scheduleArray)
    End If

    ReDim Preserve scheduleArray(arrLength + 1) //Resize array
    scheduleArray(arrLength) = startTime //Add start time
End Sub
1 голос
/ 05 января 2011

Каждый раз, когда вы вызываете Application.Ontime, сохраняйте время, установленное для запуска события (вы можете сохранить его на листе или в динамическом массиве с областью действия модуля)

Каждый раз, когда запускается ваше событие, удаляйте соответствующиесохраненное время

Чтобы отменить все ожидающие события, выполните итерации оставшегося сохраненного времени, вызвав Application.Ontime с schedule = false

...