我正在编写一个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

最佳答案

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

Public notificationTime As Date

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


通过执行notificationTime公共变量,您可以使用它引用之前计划的完全相同的过程,并使用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

关于excel - 如何停止Application.OnTime自身重叠?,我们在Stack Overflow上找到一个类似的问题:https://stackoverflow.com/questions/41524743/

10-10 18:48
查看更多