作者：绿色风
分类：
时间：2022-08-17
浏览：122
楼主
kevinchengcw |
Q: 如何用vba代码为指定内容在设定时间到达前10分钟及5分钟进行语音及视觉提醒?
A: 代码如下:(运行电脑需要安装语音阅读引擎)
- Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) '声明sleep函数,用于后面的延时操作
- Sub test()
- Dim Rng As Range, R1 As Range, R2 As Range, Str$, Str2$, N&
- Str = "" '初始化记录内容的变量为空
- Str2 = ""
- For Each Rng In Range([a4], Cells(Rows.Count, 1).End(3)) '循环单元格指定区域
- If Hour(Rng.Offset(, 2).Value) * 60 + Minute(Rng.Offset(, 2).Value) - Hour(Now) * 60 - Minute(Now) = 10 Then '判断对应列设定时间与当前时间的差值为10分钟,则
- Str = Str & Rng.Value & " " '利用空格分隔将符合10分钟标准的内容串接起来
- If R1 Is Nothing Then '并将对应的单元格赋值给变量
- Set R1 = Rng
- Else
- Set R1 = Union(R1, Rng)
- End If
- ElseIf Hour(Rng.Offset(, 2).Value) * 60 + Minute(Rng.Offset(, 2).Value) - Hour(Now) * 60 - Minute(Now) = 5 Then '对于符合5分钟标准的单元格操作同上
- Str2 = Str2 & Rng.Value & " "
- If R2 Is Nothing Then
- Set R2 = Rng
- Else
- Set R2 = Union(R2, Rng)
- End If
- End If
- Next Rng
- If Trim(Str2) <> "" Then Str2 = Str2 & "还有5分钟即将上线" '判断取得是数据是否有效,有效则串接上提示语句
- If Trim(Str) <> "" Then Str = Str & "还有10分钟即将上线"
- If Trim(Str) <> "" Or Trim(Str2) <> "" Then
- Str = "请注意 " & Trim(Str2) & " " & Trim(Str) '最后将有效数据完全串接在一起,以实现一次性发音读出
- For N = 1 To 3 '循环读出三次,以达到提示效果
- Application.Speech.Speak Str
- Next N
- For N = 1 To 100 '语音提示完成后,利用单元格变色实现视觉提醒功能(闪烁50次)
- If N Mod 2 = 0 Then '变量是偶数时清除单元格颜色
- If Not R1 Is Nothing Then R1.Interior.ColorIndex = xlNone
- If Not R2 Is Nothing Then R2.Interior.ColorIndex = xlNone
- Else '奇数时,差10分钟的单元格显示黄色,差5分钟的单元格显示红色
- If Not R1 Is Nothing Then R1.Interior.Color = vbYellow
- If Not R2 Is Nothing Then R2.Interior.Color = vbRed
- End If
- Sleep (100) '延时0.1秒进入下一次循环
- Next N
- End If
- Application.OnTime Now + TimeValue("00:00:20"), "test" '每20秒调用一次本程序(具体时间可根据精度等要求进行调整)
- End Sub
详见附件及素材源帖.
 提前语音及视觉提醒.rar
|
2楼
yg5chai9z |
无私是稀有的道德，因为从它身上是无利可图的。 |
3楼
传递 |
VBA 太强大了 |
4楼
sharkzhou |
怎样弄语音阅读引擎啊？谢谢 |
免责声明
有感于原ExcelTip.Net留存知识的价值及部分知识具有的时间限定性因素，
经与ExcelTip.Net站长Apolloh商议并征得其同意，
现将原属ExcelTip.Net的知识帖采集资料于本站点进行展示，
供有需要的人士查询使用，也慰缅曾经的论坛时代。
所示各个帖子的原作者如对版权有异议，
可与本人沟通提出，或于本站点留言，我们会尽快处理。
在此，感谢ExcelTip.Net站长Apolloh的支持，感谢本站点所有人**绿色风（QQ:79664738)**的支持与奉献，特此鸣谢！
------本人网名**KevinChengCW（QQ:1210618015)**原ExcelTip.Net总版主之一