Application.OnTime方法应用实例2：倒计时器

vba中application.ontime方法，创建一个定时器使某个过程在指定的时间运行。

其语法如下：

Application.OnTime(EarliestTime,Procedure as string,LatestTime],[Schedule])

• • 参数EarliestTime为预定的程序开始时间。
  • 参数Procedure为过程的名称。
  • 参数LatestTime为程序最后的运行时间。
  • 参数Schedule参数Schedule为逻辑值，当为True（默认值）时，表示创建一个定时器，在由参数EarliestTime所指定的时间运行由参数Procedure所指定的过程，当为False时，表示取消由参数EarliestTime所指定运行时间的定时器。

运用ontime方法，编写一个倒计时小程序，vba代码如下：

Dim t, k

Sub 开始()

Range("A1") = "倒计时时长（分钟)"

Range("B1") = "剩余时间"

k = 3 '防止重复点击"开始"，导致多个ontime同时运行

Application.OnTime Now + TimeValue("00:00:02"), "开始倒计时" '延迟2s开始，使得由于重复点击"开始"导致多个运行的ontime有时间停止

End Sub

Sub 开始倒计时()

输入倒计时时长

显示倒计时

End Sub

Sub 输入倒计时时长()

t = Range("A2")

If Application.IsNumber(t) Then

    If t > 0 And Int(t) = t Then

    t = VBA.TimeSerial(VBA.Fix(t / 60), t Mod 60, 1)

    k = 1

    Exit Sub

    End If

End If

MsgBox "请输入正确格式的倒计时时长（分钟）"

k = 3

End Sub

Sub 显示倒计时()

Dim x

If k = 1 Then       '开始或继续倒计时

    If VBA.DateDiff("s", "00:00:00", t) > 0 Then

        t = VBA.DateAdd("s", -1, t)

        Range("B2") = VBA.Format(t, "hh:mm:ss")

        Application.OnTime Now + TimeValue("00:00:01"), "显示倒计时"

    Else

        Exit Sub

    End If

End If

If k = 2 Then      '暂停倒计时

    Application.OnTime Now + TimeValue("00:00:01"), "显示倒计时"

End If

If k = 3 Then     '停止倒计时

      Range("B2") = ""

    Exit Sub

End If

x = VBA.DoEvents

End Sub

Sub 继续倒计时()

k = 1

End Sub

Sub 暂停倒计时()

k = 2

End Sub

Sub 停止倒计时()

k = 3

End Sub

在编写这个小程序的一个难点是：在Excel指定宏后，当重复点击“开始”时，倒计时不是一秒一秒进行倒计时的，而每次2秒（或更多秒）进行倒计时的。分析后发现原因是，当重复当击“开始”时，由于k没有及时获取值3，终止掉前面的ontime，导致多个ontime在运行。

解决方法，加入一个延迟2s的开始倒计时，这样就可以终止掉前面的ontime，具体代码如下：

Sub 开始（）

……

k = 3 '防止重复点击"开始"，导致多个ontime同时运行

Application.OnTime Now + TimeValue("00:00:02"), "开始倒计时" '延迟2s开始，使得由于重复点击"开始"导致多个运行的ontime有时间停止

……

End sub