Таймер обратного отсчета не работает - PullRequest
Новая
       7

Таймер обратного отсчета не работает

0 голосов
/ 11 февраля 2019

Я использовал этот код с успехом в качестве таймера обратного отсчета, но он не работает в качестве таймера обратного отсчета .Я получаю

Ошибка 1004 Определяемая приложением og объектная ошибка

в строке 

Cell.Value = CountDown - (Timer - Start - 86400 * (Start > Timer)) / 86400

Я думаю, что она умножается с нуля.

Я знаю, что код будет работать с Cell.Value = CountDown - TimeSerial(0, 0, Timer - Start), но я не могу его использовать, в то время как TimeSerial - это вариант (целое число), что означает, что код может выполнить только 32767 отсчетов в секундах, прежде чем он остановится.в Ошибка переполнения .У кого-нибудь есть идеи, как обойти проблему ошибки 1004 в коде ниже. 

Option Explicit

Sub NewTimer() 'Countdown timer
    Dim Start As Long
    Dim Cell As Range
    Dim CountDown As Date

    Start = Timer

    Set Cell = Sheet1.Range("B1")    'This is the starting value.
    CountDown = TimeSerial(0, 0, 10)    'Set takttime
    Cell.Value = CountDown

    Do While Cell.Value > 0
        Cell.Value = CountDown - (Timer - Start - 86400 * (Start > Timer)) / 86400
        DoEvents
    Loop
End Sub

Ответы [ 2 ]

0 голосов
/ 12 февраля 2019

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

Sub OtherTimer()
    Dim UserInput As String
    UserInput = "00:00:10"

    Dim SecondsToRun As Long
    SecondsToRun = CDbl(TimeValue(UserInput)) * 24 * 60 * 60

    Dim TimerStart As Double
    TimerStart = Timer 'remember when timer starts

    Do
        Range("B1").Value = Format$((SecondsToRun - (Timer - TimerStart)) / 24 / 60 / 60, "hh:mm:ss")
        'count backwards from 01:15 format as hh:mm:ss and output in cell A1

        DoEvents
    Loop While TimerStart + SecondsToRun > Timer 'run until SecondsToRun are over
End Sub
0 голосов
/ 11 февраля 2019

Вместо использования логического значения в цикле используйте переменную, которая принимает 1 или 0. Это устранит ошибку. 

Dim temp As Integer
# ...
Do While Cell.Value > 0
    If Start > Timer Then
        temp = 1
    Else
        temp = 0
    End If

    Cell.Value = CountDown - (Timer - Start - 86400 * temp) / 86400
    DoEvents
Loop

Чтобы избежать ошибки переполнения, вы можете изменить тип CountDown наdouble и вместо использования функции TimeSerial укажите время в днях.Некоторые примеры: 

CountDown = 1 # 1 day
CountDown = 1/24 # 1 hour
CountDown = 1/24/60 # 1 minute
CountDown = 1/24/60/60 # 1 second
CountDown = 2/24 + 40/24/60/60 # 2 hours and 40 seconds
...