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