VBA 用户窗体 - 自定义倒数计时器工作分钟数但无法实现自定义秒数

Question

我已经实现了一个倒计时计时器，它现在可以在用户输入文本框的整分钟内工作（例如 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

Answer 1

这里有一个示例，说明如何计算计时器以及如何格式化 input/output。

您需要验证您的用户输入格式并将其转换为 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.

Answer 2

我曾使用 "Peh" 解决方案，但使用了 ontime 事件。
根据确切的开始时间，结果不可预测：

你会如何改进它？
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

VBA 用户窗体 - 自定义倒数计时器工作分钟数但无法实现自定义秒数

VBA UserForm - Custom count-down timer for minutes working but cannot implement custom seconds

excel

vba

userform