VBA UserForm - Пользовательский таймер обратного отсчета для минут работы, но не может реализовать пользовательские секунды - PullRequest
0 голосов
/ 22 января 2019

Я реализовал таймер обратного отсчета, который теперь работает в течение целых минут, введенных пользователем в текстовое поле (например, 05:00), однако я борюсь за реализацию функциональности для пользователя, чтобы также вводить свои собственные секунды.

В пользовательской форме есть кнопка «Timercustom», при нажатии на которую подпрограмма будет обновлять каждую секунду текстовое поле «TextBox3» в формате 00:00 (например, 05: 00) для обратного отсчета с начальной до 00:00..

Может ли кто-то с большим опытом работы с VBA помочь внести изменения, чтобы добавленные дополнительные секунды также отсчитывались?Я пытался сделать это несколько часов, но вернулся к приведенному ниже рабочему коду на целые минуты только для ясности.

'Initialisation function
Private Sub UserForm_Initialize()
Dim M As Double, S As Double
M = Int(CDbl(AllowedTime))
S = (CDbl(AllowedTime) - Int(CDbl(AllowedTime))) * 60
 With TextBox1
    .Value = Format(CStr(M), "15") & ":" & Format(CStr(S), "00")
End With

With TextBox2
    .Value = Format(CStr(M), "45") & ":" & Format(CStr(S), "00")
End With

With TextBox3
    .Value = Format(CStr(M), "5") & ":" & Format(CStr(S), "00")
End With
End Sub


'main function to start the timer
Private Sub Timercustom_Click()
Dim t, E, M As Double, S As Double
Dim AllowedTime As Integer
Dim TextStrng As String
Dim Result() As String
Dim tempS As Double
Dim firstRun As Boolean


firstRun = True

TextStrng = TextBox3.Value
Result() = Split(TextStrng, ":")

AllowedTime = Result(0)
t = Timer

Do
    If Timer - t < 0 Then
        Unload UserForm1
        MsgBox "Error encountered - start again"
        Exit Sub
    End If
    E = CDbl(Time) * 24 * 60 * 60 - t 'elapsed time in secs
    M = (CDbl(AllowedTime) - 1) - Int(E / 60)

    'this just avoids a weirdity where the seconds initially goes to 00:0-1, for some reason
    If tempS < 0 Then
    tempS = Result(1)
    End If

    S = tempS

    With TextBox3
        .Value = Format(CStr(M), "00") & ":" & Format(CStr(S), "00")
    End With
    DoEvents
Loop Until (Timer - t) / 60 >= CDbl(AllowedTime) Or UserForm1.Visible = False 

End Sub

Ответы [ 2 ]

0 голосов
/ 22 января 2019

Я работал с решением "Peh", но использовал событие ontime.Результат не предсказуем в зависимости от точного времени начала:

enter image description here

Как бы вы улучшили это?1. Таймер не должен заканчиваться положительным значением 00:01!2. Таймер не должен заканчиваться отрицательным значением!(также отображается как 00:01)

Option Explicit
Dim TimerStart As Double
Dim SecondsToRun As Long
Dim UserInput As String
Dim LatestStartTime As Variant
Dim rowCt As Integer
Dim colCt As Integer

Sub ResetColCount()
    colCt = 0
    Range("A1:Z10").Clear
End Sub

Public Sub TimerExample()
    UserInput = "00:03" 'this is what the user inputs and how long the timer should run
    rowCt = 0
    colCt = colCt + 1

    'validate userinput und ensure hh:mm:ss format
    Select Case Len(UserInput) - Len(Replace$(UserInput, ":", ""))
        Case 2 'input format is hh:mm:ss

        Case 1 'input format is mm:ss
            UserInput = "00:" & UserInput
        Case 0 'input format is ss
            UserInput = "00:00:" & UserInput
        Case Else
            MsgBox "invalid input"
            Exit Sub
    End Select

    'we need to convert the string UserInput into a double and
    'convert it into seconds (Timer uses seconds!)
    SecondsToRun = CDbl(TimeValue(UserInput)) * 24 * 60 * 60

    TimerStart = Timer 'remember when timer starts
    Cells(1 + rowCt, colCt).Value = Format$((SecondsToRun - (Timer - TimerStart)) / 24 / 60 / 60, "hh:mm:ss")
    rowCt = rowCt + 1
    LatestStartTime = Now() + TimeValue(UserInput) + TimeValue("00:00:01")

    Application.OnTime Now() + TimeValue("00:00:01"), "UpdateTime", LatestStartTime

End Sub

Sub UpdateTime()
    Cells(1 + rowCt, colCt).Value = Format$((SecondsToRun - (Timer - TimerStart)) / 24 / 60 / 60, "hh:mm:ss")
    rowCt = rowCt + 1
    If TimerStart + SecondsToRun > Timer Then
        Application.OnTime Now() + TimeValue("00:00:01"), "UpdateTime", LatestStartTime
    End If
End Sub
0 голосов
/ 22 января 2019

Вот пример того, как сделать вычисления для таймера и как отформатировать ввод / вывод.

Вам необходимо проверить свой формат ввода пользователя и преобразовать его в hh:mm:ss, например, если ваш пользовательвходы 01:15, что составляет mm:ss, вам нужно преобразовать его в 00:01:15.Затем этот формат можно преобразовать в реальное время с помощью TimeValue, а с помощью CDbl(TimeValue(UserInput)) * 24 * 60 * 60 вы получите количество секунд этого времени.

Обратите внимание, что нам нужно преобразовать время в секунды, поскольку ваш Timerрассчитывается в секундах.

SecondsToRun - (Timer - TimerStart) дает вам количество секунд, оставшихся на вашем таймере.А с помощью Format$((SecondsToRun - (Timer - TimerStart)) / 24 / 60 / 60, "hh:mm:ss") вы можете отформатировать секунды как удобочитаемое время.

Option Explicit

Public Sub TimerExample()
    Dim UserInput As String
    UserInput = "01:15" 'this is what the user inputs and how long the timer should run

    'validate userinput und ensure hh:mm:ss format
    Select Case Len(UserInput) - Len(Replace$(UserInput, ":", ""))
        Case 2 'input format is hh:mm:ss

        Case 1 'input format is mm:ss
            UserInput = "00:" & UserInput
        Case 0 'input format is ss
            UserInput = "00:00:" & UserInput
        Case Else
            MsgBox "invalid input"
            Exit Sub
    End Select

    'we need to convert the string UserInput into a double and
    'convert it into seconds (Timer uses seconds!)
    Dim SecondsToRun As Long
    SecondsToRun = CDbl(TimeValue(UserInput)) * 24 * 60 * 60

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

    Do
        Cells(1, 1).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

Таким образом, этот код запустит таймер, который отсчитывает в обратном направлении от 01:15 (1 минута, 15 секунд) назад до 0,Выход будет в ячейке A1 следующим образом:

00:01:15
00:01:14
00:01:13
00:01:12
00:01:11
00:01:10
00:01:09
00:01:08
and so on.
...