VBA实现 倒计时

发布时间 2023-05-09 15:53:56作者: 小清澈

实现效果:

  控件展示倒计时读秒,修改tt的值即 倒计时时间。点击控件开始/暂停倒计时读秒。双击控件 重置读秒时间。

模块1:

Declare PtrSafe Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As Long
Declare PtrSafe Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
Option Explicit
Public tt As Long
Public dd As Integer
Public hh As Integer
Public mm As Integer
Public ss As Integer
Public str As String
Public mTimer  As Long
Public flag As Integer
 
Sub timer()
  Call timelable
  If tt > 0 Then
    Slide502.CommandButton1.Caption = "演讲倒计时,还剩 " & str
    Slide503.CommandButton1.Caption = "演讲倒计时,还剩 " & str
    Slide504.CommandButton1.Caption = "演讲倒计时,还剩 " & str
    tt = tt - 1
  Else
    tt = 0
    Slide502.CommandButton1.Caption = "演讲已结束"
    Slide503.CommandButton1.Caption = "演讲已结束"
    Slide504.CommandButton1.Caption = "演讲已结束"
    mTimer = KillTimer(0, mTimer)
  End If
End Sub

Sub timelable()
  If tt >= 86400 Then
    dd = tt \ 8640
    hh = (tt Mod 8640) \ 3600
    mm = ((tt Mod 8640) Mod 3600) \ 60
    ss = ((tt Mod 8640) Mod 3600) Mod 60
    str = dd & " 天 " & hh & " 小时 " & mm & " 分 " & ss & " 秒"
  ElseIf tt < 86400 & tt >= 3600 Then
    dd = 0
    hh = tt \ 3600
    mm = (tt Mod 3600) \ 60
    ss = ((tt Mod 3600) Mod 60) \ 60
    str = hh & " 小时 " & mm & " 分 " & ss & " 秒"
  ElseIf tt < 3600 & tt >= 60 Then
    dd = 0
    hh = 0
    mm = tt \ 60
    ss = (tt Mod 60) \ 60
    str = mm & " 分 " & ss & " 秒"
  Else
    dd = 0
    hh = 0
    mm = 0
    ss = tt
    str = ss & " 秒"
  End If
End Sub

Sub start()
    mTimer = SetTimer(0, 0, 1000, AddressOf timer)
End Sub
 

 

控件1:

Private Sub CommandButton1_Click()
  Static sum
  If sum = 0 Then
    tt = 10
    sum = sum + 1
  End If
  If flag = 0 Then
    Call start
    flag = 1
  Else
    mTimer = KillTimer(0, mTimer)
    flag = 0
    Slide502.CommandButton1.Caption = "暂停,还剩 " & str
  End If
End Sub



Private Sub CommandButton1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
  tt = 10
  mTimer = KillTimer(0, mTimer)
 
  Slide502.CommandButton1.Caption = "开始"
End Sub