Вызов sub не завершается до того, как l oop перейдет к следующей итерации в VBA. - PullRequest
Новая
       46

Вызов sub не завершается до того, как l oop перейдет к следующей итерации в VBA.

1 голос
/ 31 марта 2020

Я пишу кусок кода VBA для отображения таймера обратного отсчета. В Excel Sheet 1 перечислены времена и описания событий, а на листе 2 отображается обратный отсчет.

Идея состоит в том, что после первого обратного отсчета первого события проверяется дата второго события, а если это сегодня, продолжается обратный отсчет до второго события и так далее. Аспект обратного отсчета успешно работает в первый раз и в описании, но когда он завершает обратный отсчет до первого события, он полностью останавливается.

Есть 3 подпрограммы, первая работает, если событие сегодня и как долго нужно отсчитывать время. Первый вызывает второй, который выполняет обратный отсчет, вычитая TimeSerial(0,0,1), а третий - таймер. Я признаю, что я позаимствовал 2-е и 3-е у хорошо написанного произведения, которое я нашел в Интернете (спасибо тому, кто это написал, спасибо).

Я упростил то, что написал ниже: 

For i=1 to 10
    If *Conditions to determine if countdown should happen exist*
    *calculate time to countdown and sets it to sheets("Countdown").Cells("A13")*
       Cells(13, 1) = TotaltimeCountdown
       Call Countdowntimer
    End if
 Next i

Sub Countdowntimer()
    Sheets("Countdown").Activate
    Dim Counter As Range        
    Set Counter = ActiveSheet.Range("A13")

    If Counter.Value > 0 Then
        Counter.Value = Counter.Value - TimeSerial(0, 0, 1)
        Call Timer
    ElseIf Counter.Value <= 0 Then
        Sheets("Countdown").Range("A13:H17").ClearContents
        Exit Sub
    End If              
End Sub

'Sub to trigger the reset of the countdown timer every second
Sub Timer()
    Dim gCount As Date
    gCount = Now + TimeValue("00:00:01")
    Application.OnTime gCount, "Countdowntimer"
End Sub

Я поместил окно сообщения после вызова Countdowntimer в первом сабвуфере и смог установить sh, что он отображает количество времени для обратного отсчета, затем отобразил окно сообщения и прокрутил каждое значение i. Только тогда он действительно начал обратный отсчет.

Любые предложения о том, как заставить паузу для l oop полностью остановиться, пока не закончится обратный отсчет от вызываемого субмарина?

Любые предложения приветствуются

1 Ответ

1 голос
/ 31 марта 2020

Проблема использует Application.OnTime и для таймера обратного отсчета используйте Do l oop с DoEvents для обратного отсчета.

Что-то вроде этого: 

Option Explicit

Public Sub CountDownTimer()
    With ThisWorkbook.Worksheets("Countdown")
        Dim Duration As Long
        Duration = 10 ' needs to be in seconds!
        'if your cell has a real datetime then use
        Duration = .Range("A13").Value * 24 * 60 * 60

        Dim TimerStart As Double
        TimerStart = Timer()

        Do While Timer <= TimerStart + Duration
            .Range("A13").Value = TimeSerial(0, 0, TimerStart + Duration - Timer)
            DoEvents
        Loop

        ThisWorkbook.Worksheets("Countdown").Range("A13:H17").ClearContents
    End With
End Sub
...