9836498162495 发表于 2016-4-12 13:36:35

PPT VBA 倒计时和动态数字时钟

Private Declare Function GetTickCount Lib "kernel32.dll" () As Long
Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
Private Declare Function PlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszName As String, ByVal uFlags As Long) As Long
Const InterVal = 1000
Private Sub CommandButton1_Click()
Static State, myStop As Boolean
Dim preTime, curTime, myTime, jsTime, txTime As Long
If State Then myStop = True: Exit Sub
CommandButton1.Caption = "Stop Counting"
State = True
preTime = GetTickCount
myTime = Val(TextBox2) + 1
jsTime = Val(TextBox2) + 2
txTime = Val(TextBox3)
Label3.Visible = False
Label4.Visible = False
TextBox2.Visible = False
TextBox3.Visible = False
Label2.Caption = "Counting..."
Do
curTime = GetTickCount
If curTime - preTime >= InterVal * (jsTime - myTime) Then
myTime = myTime - 1
TextBox1 = myTime
DoEvents
If myTime = txTime Then
Label2.Caption = "soon..."
Call PlaySound("Ding.wav", 0&)
End If
If myTime = 0 Then
State = False
myStop = False
CommandButton1.Caption = "Start Counting"
Call PlaySound("End.wav", 0&)
Exit Do
End If
End If
Sleep (20)
Label1 = Time
DoEvents
If myStop Then
State = False
myStop = False
CommandButton1.Caption = "Start counting"
MsgBox "Time up", vbInformation + vbOKOnly, "notice"
Exit Do
End If
Loop
Label2.Caption = "Time up!"
Label3.Visible = True
Label4.Visible = True
TextBox2.Visible = True
TextBox3.Visible = True
End Sub

user_xcmqp 发表于 2016-4-12 14:36:47

斑主，请上传附件，谢谢你

5160774 发表于 2016-4-12 17:47:01

哈哈，我需要附件
页: [1]
查看完整版本: PPT VBA 倒计时和动态数字时钟