Как запустить функцию «Beep» во второй раз в VBA
Я создал динамический планировщик дел, который позволяет пользователю вводить задачи вместе с временем их начала.
Часы идут в режиме реального времени, а для выделения текущей задачи зеленым цветом используется условное форматирование. Когда часы доходят до n секунд (согласно WarningSeconds) до времени начала следующей задачи, текущая задача становится красной, и звук Beep воспроизводится пять раз.
Затем, когда начинается следующая задача, она становится зеленой, а предыдущая перечеркивается. Это здорово, но я хочу, чтобы Beep также сыграл пять раз в начале нового задания. Я пробовал разные вещи, но ни одна из моих реализаций не работает.
Что я могу добавить в свой код, чтобы это заработало?
Посмотрите пример здесь: https://i.postimg.cc/Pt8wb6Cr/2024-08-15-21-59-54.png.
Здесь Beep играет пять раз в 17:29:50, но мне нужно, чтобы он играл и в 17:30:00.
#If VBA7 Then
Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
#Else
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If
Public IsRunning As Boolean
Public AlarmCounter As Integer
Sub StartStopClock()
IsRunning = Not IsRunning
AlarmCounter = 0 ' Initialise the counter
' Start the timer
TimerLoop
End Sub
Sub TimerLoop()
On Error Resume Next
Do While IsRunning
DoEvents
Sheet1.Range("Clock").Value = TimeValue(Now)
If AlarmCounter < 5 Then
ActivateAlarm
End If
Loop
End Sub
Sub ActivateAlarm()
If Range("WarningAlert").Value = True Then
Beep
Sleep (1000)
AlarmCounter = AlarmCounter + 1 ' Increment the counter
End If
End Sub
Формула для WarningAlert:
=AND(Clock>=ROUND(MINIFS(tblTask[Time],tblTask[Time],">"&Clock)-TIME(0,0,WarningSeconds),10),Clock<MAX(tblTask[Time]))
Ответы 1
Одним из важных элементов цикла таймера является использование Sleep в сочетании с DoEvents, чтобы гарантировать, что потребление процессора остается низким. По крайней мере, это сделало мою Excel-Pomodoro-Timer более плавной и помогла сделать Excel более отзывчивым. Оно может составлять всего 10 миллисекунд, но при этом иметь большое значение.
Если вы не хотите, чтобы это испортило время, вы всегда можете сохранить его внутри оператора if:
DoEvents
If AlarmCounter = 0 Then
Sleep (10)
End If
Что касается вашей проблемы с невозможностью воспроизвести сигнал тревоги в начале задачи, я бы предложил использовать переменные флагов, чтобы вы могли контролировать, в каком состоянии находится цикл. Например, находимся ли мы в состоянии проигрывание будильника по окончании задачи; ждем ли мы запуска следующего задания; и т. д.
Одна из возможных реализаций может выглядеть примерно так:
Public IsRunning As Boolean
Public AlarmCounter As Integer
Sub StartStopClock()
IsRunning = Not IsRunning
AlarmCounter = 0 ' Initialise the counter
' Start the timer
TimerLoop
End Sub
Sub TimerLoop()
'We need to Resume Next to avoid errors occuring if we edit cells inside Excel while the loop is running.
On Error Resume Next
Do While IsRunning
DoEvents
If AlarmCounter = 0 Then
Sleep (10)
End If
Sheet1.Range("Clock").Value = TimeValue(Now)
Dim NotificationOngoing As Boolean
Dim WaitingForNextTask As Boolean
If Range("WarningAlert").Value = True And Not WaitingForNextTask Then
NotificationOngoing = True
End If
If NotificationOngoing Then
If AlarmCounter < 5 Then
ActivateAlarm
Else
AlarmCounter = 0
NotificationOngoing = False
WaitingForNextTask = True
Dim NextTaskStart As Date
NextTaskStart = Now + (ThisWorkbook.Names("WarningSeconds").RefersToRange.Value2 - 5) / 24 / 3600
End If
End If
If WaitingForNextTask And Now >= NextTaskStart Then
If AlarmCounter < 5 Then
ActivateAlarm
Else
AlarmCounter = 0
WaitingForNextTask = False
End If
End If
Loop
End Sub
Sub ActivateAlarm()
Beep
Sleep (1000)
AlarmCounter = AlarmCounter + 1 ' Increment the counter
End Sub
@Statto, это справедливо. Я отредактировал ответ, чтобы отразить это.
Я обнаружил, что
On Error Resume Nextнеобходим для предотвращения остановки часов при редактировании ячейки.