头条文章——有效利用VBA中OnTime方法实现倒计时设计

哈喽，大家好，上次我们利用了OnTime方法实现了数码管时钟的设计，感觉它还是蛮神奇的，不是吗？呵呵，当时我在视频里就说过，我准备利用这个方法继续推出有关倒计时的作品。

为什么我们要设计倒计时器呢？倒计时器已成为人们日常生活中必不可少的物品，广泛用于个人家庭以及车站、码头、剧院、办公室等公共场所，给人们的生活、学习、工作、娱乐带来极大的方便。随着技术的发展，人们已不再满足于钟表原先简单的 时功能，希望出现一些新的功能，诸如日历的显示、闹钟的非接触式止闹、跑表功能、重要日期倒计时显示等，以带来更大的方便，而所有这些，又都是以数字化的倒计时器为基础的，而作为办公室Office办公工作人员，做的事情也很杂，很有可能领导会将单位某个活动、节日等事宜的时间提示让你用倒计时的方式通过电脑呈现在LED屏幕供单位上下都天天能够看到。但是，作为Office办公工作人员一般都不是很懂用单片机技术去设计，鉴于如此情况，是否我们就没法做到设计倒计时器呢？答案是否定的，我们同样可以利用Office高级应用技术在Office组件，比如在Excel、PowerPoint等里边实现设计倒计时器。因此，研究实用倒计时器及其扩展应用，有着非常现实的意义，具有很大的实用价值。

鉴于对OnTime方法的痴迷，我们以模拟世界杯倒计时为题设计了本期的倒计时作品，希望能够给予各位粉丝技术上的帮助，同时也是为了抛砖引玉哦，更感谢大家的厚爱哦！

好了，不废话了，我们还是以干货的形式给大家分享吧！

一、倒计时前端界面设计

倒计时黑屏幕、四个表单按钮。如下图所示

图1 倒计时界面

二、倒计时后台窗体界面

插入6个组合框选择列表控件和2个命令按钮。如下图所示

图2 后端窗体界面

三、倒计时器功能代码实现及前端界面四个表单按钮控件运行宏指定

(一)计时器功能代码实现

1、模块1代码：

Public TimeOn As Double ‘公有全局变量TimeOn为当前的瞬时时间，便于回传数据

Public Uload_Form_Flag As Boolean ‘公有全局变量Uload_Form_Flag为是否卸载关闭窗体的标志，便于回传数据

Public da_str, yr ‘公有全局变量da_str、yr分别为取得的日期串、取得的年 ，便于回传数据

Sub Main() ‘“倒计时器”开启的引导主程序

Call 复位倒计时

SelectDate_Time_Form.Show

If Uload_Form_Flag = False Then ‘凡是经过窗体点击了确定后，都强制性将Uload_Form_Flag置为False造 _

成假象窗体未关闭

Call 开始倒计时

Else

da_str = “” ‘一旦取消了倒计时操作后，立即清空日期串变量da_str的值

MsgBox “您取消了实施倒计时器工作的操作！”, vbInformation, “提示”

Exit Sub

End If

End Sub

‘Application.OnTime方法的参数说明

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

‘EarliestTime调用程序的时间

‘Procedure调用程序的程序名，类型String

‘LatestTime程序执行的结束时间，可选，默认不停调用

‘Schedule默认True：预定新的调用过程，False非预定调用新的过程

Sub 开始倒计时() ‘“倒计时器”的具体子程序定义

Dim da As Date

da = VBA.CDate(da_str) ‘未来日期时间da

If da < Now Then ‘未来时间比当前时间早，则 错，终止程序运行

MsgBox “未来时间” & Format(da, “yyyy-m-d hh:mm:ss”) & “小于或迟于当前时间” & Now & _

“的错误,退出！”, vbInformation, “提示”

Call 复位倒计时

Exit Sub

Else

TimeOn = Now + TimeSerial(0, 0, 1) ‘等价于Now + TimeValue(“:01”)以1秒为步进定时跳变

s = DateDiff(“s”, Now, da) ‘s首先取得在这个时间差内，以秒为单位的所有秒数

Y = Int(s / 31536000) ‘一年按照365天换算算是【31536000】秒，取整强烈建议用Int(s / 31536000)纯 _

粹去小数非四舍五入的的整除而非s31536000这种纯粹去小数非四舍五入的的整除，原因是s31536000容 _

易发生数据溢出,以下类似

s = s – Y * 31536000 ‘取得即将取“月”数所用的秒数

mon = Int(s / 2592000) ‘一月按30天换算算是【2592000】秒，非四舍五入取整得到月数mon

s = s – mon * 2592000 ‘取得即将取“天”数所用的秒数

d = Int(s / 86400) ‘一天换算是【86400】秒，非四舍五入取整得到天数d

s = s – d * 86400 ‘取得即将取“小时”数所用的秒数

h = s 3600 ‘一小时换算是【3600】秒，非四舍五入取整”s3600″(“s3600″针对短数据可以这样非四 _

舍五入的整除)得到小时数h,以下解释类似

s = s – h * 3600 ‘取得即将取“分钟”数所用的秒数

m = s 60 ‘一分钟换算是【60】秒，非四舍五入取整得到分钟数m

s = s – m * 60 ‘取得最后零头“秒”数s

If Y = 0 And mon = 0 And d = 0 And h = 0 And m = 0 And s = 0 Then

Dim rg As Range, str_words As String, start_Font_Size As Integer, end_Font_Size As Integer

MsgBox “时间到！”, vbInformation, “提醒”

str_words = Format(da, “yyyy年”) & “世界杯欢迎您!”

Set rg = Sheets(1).Cells(1, 1)

rg.HorizontalAlignment = xlCenter ‘rg范围中的内容居中对齐

start_Font_Size = 1 ‘设置动画起始字体 1

end_Font_Size = 40 ‘设置动画结束字体 40

‘调用两次scale_words过程，以增强文字缩放动画效果

scale_words str_words, rg, start_Font_Size, end_Font_Size ‘第一次调用字体缩放动画过程

scale_words str_words, rg, start_Font_Size, end_Font_Size ‘第二次调用字体缩放动画过程

da_str = “” ‘完成了倒计时，清空日期串变量da_str的值

Exit Sub ‘强行结束过程

Else

h = IIf(h < 10, “0” & h, h) ‘将“小时”变为两位的形式(10以下的高位用0占位)

m = IIf(m < 10, “0” & m, m) ‘将“分钟”变为两位的形式(10以下的高位用0占位)

s = IIf(s < 10, “0” & s, s) ‘将“秒”变为两位的形式(10以下的高位用0占位)

display_str = “距离 ” & Format(da, “yyyy年m月d日”) & “【世界杯】运动会还有：” _

& Y & ” 年 ” & mon & ” 个月 ” & d & ” 天” & Chr(10) & “剩余时间[” & h & “:” _

& m & “:” & s & “]” & Chr(10) & “当前时间：” & Format(Now, “yyyy年m月d日 hh:mm:ss”)

Cells(1, 1) = display_str

Application.OnTime TimeOn, “开始倒计时”, , True ‘开始定时地回调过程“开始倒计时”自身

End If

End If

End Sub

Sub 暂停倒计时()

If da_str = “” Then ‘若获得的日期串为空，则终止任何操作

prompt_str = “您没有启动倒计时或复位过倒计时” & Chr(10) & “或可能刚才点击了<启动倒计时>按” _

& Chr(10) & “钮却未选择倒计时参数！” & Chr(10) & “禁止暂停倒计时！”

MsgBox prompt_str, vbInformation, “提示”

Exit Sub

Else ‘否则，执行应有的暂停倒计时操作

Application.OnTime TimeOn, “开始倒计时”, , False ‘终止定时地回调过程“开始倒计时”自身

End If

End Sub

Sub 继续倒计时()

If da_str = “” Then ‘若获得的日期串为空，则终止任何操作

prompt_str = “您没有启动倒计时或复位过倒计时” & Chr(10) & “或可能刚才点击了<启动倒计时>按” _

& Chr(10) & “钮却未选择倒计时参数！” & Chr(10) & “无法继续倒计时！”

MsgBox prompt_str, vbInformation, “提示”

Exit Sub

Else ‘否则，执行应有的继续倒计时操作

Application.OnTime TimeOn, “开始倒计时”, , True ‘继续开始定时地回调过程“开始倒计时”自身

End If

End Sub

Sub 复位倒计时()

On Error Resume Next

Application.OnTime TimeOn, “开始倒计时”, , False ‘终止定时地回调过程“开始倒计时”自身

display_str = “距离 —-年–月–日【世界杯】运动会还有： – 年 — 个月 — 天” & Chr(10) _

& “剩余时间[–:–:–]” & Chr(10) & “当前时间：—-年–月–日 –:–:–“

Cells(1, 1).Font.Size = 24

Cells(1, 1) = display_str

da_str = “” ‘一旦复位倒计时操作后，立即清空日期串变量da_str的值

On Error GoTo 0

End Sub

‘If y Mod 400 = 0 Or (y Mod 100 <> 0 And y Mod 4 = 0) Then 闰年–2月29天，否则平年–2月28天

Function Is_LeepYear(Y) As Boolean ‘判断是否是闰年Leep year

If Y Mod 400 = 0 Or (Y Mod 100 <> 0 And Y Mod 4 = 0) Then

Is_LeepYear = True ‘闰年

Else

Is_LeepYear = False ‘平年

End If

End Function

‘缩放文字的动画效果过程，其中：str_words缩放的文字、在rg区域缩放，缩放文字字体动画开始字体大

‘小s_fontsize、结束动画文字字体大小e_fontsize

Sub scale_words(str_words As String, rg As Range, s_fontsize As Integer, e_fontsize As Integer)

rg = str_words

m = s_fontsize ‘m获取了形式参数开始字体大小变量s_fontsize的值

Do While m <= e_fontsize ‘当前字体大小小于或等于给定的形式参数结束字体大小变量e_fontsize时循环

rg.Font.Size = m ‘设置瞬时字体大小

m = m + 1 ‘m不断变化

delay 0.01 ‘每次循环延时0.01秒

Loop

End Sub

Sub delay(t As Single) ‘自定义一个延时过程，单精度类型变量t代表延时时间间隔

Dim t1 As Single

t1 = Timer ‘t1记下瞬时的时间触发器Timer的值(Timer会不断变化的)

Do

DoEvents ‘转让控制权，让操作系统执行其他任务

Loop While Timer – t1 < t ‘新的Timer和之前的t1的差值小于给定的延时间隔时间t，则循环

End Sub

2、窗体代码：

Private Sub UserForm_Initialize() ‘窗体启动初始化

Uload_Form_Flag = False

year_ComboBox.Style = fmStyleDropDownList

month_ComboBox.Style = fmStyleDropDownList

day_ComboBox.Style = fmStyleDropDownList

hour_ComboBox.Style = fmStyleDropDownList

minute_ComboBox.Style = fmStyleDropDownList

second_ComboBox.Style = fmStyleDropDownList

month_ComboBox.Enabled = False

day_ComboBox.Enabled = False

hour_ComboBox.Enabled = False

minute_ComboBox.Enabled = False

second_ComboBox.Enabled = False

year_ComboBox.Clear

day_ComboBox.Clear

hour_ComboBox.Clear

minute_ComboBox.Clear

second_ComboBox.Clear

For i = 1900 To 9999 ‘年份选择列表初始化

year_ComboBox.AddItem i

Next

year_ComboBox.Value = Year(Date) + 1 ‘设定默认年份为现在年份+1，并将选择焦点定格在年份选择列表

year_ComboBox.SetFocus

End Sub

‘窗体卸载关闭事件

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

Uload_Form_Flag = True ‘一旦执行窗体卸载关闭(释放窗体曾经占用的资源空间)，则将Uload_Form_Flag状 _

态标志置为真，表示窗体已卸载关闭

Cancel = False ‘同时，将“取消卸载关闭窗体”标志置为“假”，以表示“不取消窗体卸载关闭”(即允许 _

卸载关闭窗体)

End Sub

Private Sub ConfirmBtn_Click() ‘确定参数选择

mon = month_ComboBox.Value

dy = day_ComboBox.Value

h = hour_ComboBox.Value

h = IIf(h = “”, 0, h)

m = minute_ComboBox.Value

m = IIf(m = “”, 0, m)

s = second_ComboBox.Value

s = IIf(s = “”, 0, s)

If yr = “” Or mon = “” Or dy = “” Then

MsgBox “日期中“年、月、日”少选或未选，请重新选定！”, vbInformation, “提示”

year_ComboBox.Clear

For i = 1900 To 9999 ‘年份选择列表初始化

year_ComboBox.AddItem i

Next

month_ComboBox.Clear

day_ComboBox.Clear

hour_ComboBox.Clear

minute_ComboBox.Clear

second_ComboBox.Clear

year_ComboBox.Value = Year(Date) + 1 ‘设定默认年份为现在年份+1，并将选择焦点定格在年份选择列表

year_ComboBox.SetFocus

Else

da_str = yr & “-” & mon & “-” & dy & ” ” & h & “:” & m & “:” & s

Unload SelectDate_Time_Form

Uload_Form_Flag = False ‘强制性将Uload_Form_Flag置为False造成假象窗体未关闭，便于真正在模块1 _

中间“倒计时器”程序正常执行

End If

End Sub

Private Sub CancelBtn_Click() ‘取消操作

Unload SelectDate_Time_Form

Exit Sub

End Sub

Private Sub
year_ComboBox_DropButtonClick() ‘用ComboBox_DropButtonClick()方法而不用ComboBox_Change _

()的原因是只有DropButtonClick()是点击组合框的下拉倒三角按钮的触发行为事件对月份组合框实施开启功能 _

，这样月份的组合框才能保证一表单启动初始化后是禁用的，开始选择年的时候，月份选择列表跟随初始化

yr = year_ComboBox.Value

month_ComboBox.Enabled = True

month_ComboBox.Clear

For i = 1 To 12

month_ComboBox.AddItem i

Next

End Sub

Private Sub month_ComboBox_Change() ‘选择月的时候，天数选择列表跟随初始化

i = month_ComboBox.Value

day_ComboBox.Enabled = True

Select Case i

Case 1, 3, 5, 7, 8, 10, 12: days_31

Case 4, 6, 9, 11: days_30

Case 2: days_29_Or_28

End Select

End Sub

Private Sub day_ComboBox_Change() ‘选择日的时候，小时选择列表跟随初始化

hour_ComboBox.Enabled = True

hour_ComboBox.Clear

For i = 0 To 23

hour_ComboBox.AddItem i

Next

End Sub

Private Sub hour_ComboBox_Change() ‘选择小时的时候，分选择列表跟随初始化

minute_ComboBox.Enabled = True

minute_ComboBox.Clear

For i = 0 To 59

minute_ComboBox.AddItem i

Next

End Sub

Private Sub minute_ComboBox_Change() ‘选择分的时候，秒选择列表跟随初始化

second_ComboBox.Enabled = True

second_ComboBox.Clear

For i = 0 To 59

second_ComboBox.AddItem i

Next

End Sub

Sub days_31() ‘月大–31天

day_ComboBox.Clear

For i = 1 To 31

day_ComboBox.AddItem i

Next

End Sub

Sub days_30() ‘月小–30天

day_ComboBox.Clear

For i = 1 To 30

day_ComboBox.AddItem i

Next

End Sub

Sub days_29_Or_28() ‘闰年2月份29天，平年2月份28天(例如2020年就是闰年)

day_ComboBox.Clear

If Is_LeepYear(yr) Then ‘闰年2月份天数

For i = 1 To 29

day_ComboBox.AddItem i

Next

Else ‘平年2月份天数

For i = 1 To 28

day_ComboBox.AddItem i

Next

End If

End Sub

3、ThisWorkbook代码：

Private Sub Workbook_Open() ‘工作簿一打开，就实施复位“倒计时器”的操作

Call 复位倒计时

End Sub

(二)端界面四个表单按钮控件运行宏指定

分别欸这四个表单控件按钮指定运行宏。如下图所示

图3 四个表单控件按钮的运行宏指派

四、倒计时运行测试界面

1、启动倒计时功能：点击“启动倒计时”按钮后，弹出选择日期时间的对话框选择。如下图所示

图4 启动倒计时

2、如果点击了参数选择窗体上的<取消>或者标题栏的<X>关闭按钮，则提示取消操作。如下图所示

图5 点击了<取消>或<X>关闭按钮的结果

3、确定要进行选择日期时间参数:选择日期时间参数后点击“确定”命令按钮。如下图所示

图6 日期时间参数选择

4、点击“确定”后的效果：执行确定命令后，开始倒计时。如下图所示

图7 确定参数后的效果

5、时间到提示：时间到了会自然提示“时间到！”提示。如下图所示

图8 时间到提醒

6、点击上图的“确定”后，前端界面出现文字缩放动画展示。如下图所示。

图9 倒计时到的前端界面文字缩放动画

五、关键技术小结

1、判断闰年和平年的方法：If y Mod 400 = 0 Or (y Mod 100 <> 0 And y Mod 4 = 0) Then 闰年–2月29天，否则平年–2月28天

2、实现窗体上各组合框选择列表的联动跟随变化：类似如下图所示

图10 各组合框选择列表的跟随智能变化

3、充分利用Select Case语句实现各个月份天数的设定：如下图所示。

图11 各月份天数设定

4、倒计时器时间到的前端文字缩放动画展示技术。代码如下截图所示

图12 时间到的前端文字缩放动画展示代码

好了，倒计时的完整设计的头条文章就分享到这里，希望大家多多点评和关注（“头条 ：跟我学office高级办公”）哦！