搜档网
当前位置:搜档网 › 用EXCEL进行语音提醒(VBA 定时 播放)

用EXCEL进行语音提醒(VBA 定时 播放)

工作簿中
Private Sub Workbook_Open()
Call aaa
End Sub



模中
Sub aaa()
Application.OnTime Now() + TimeValue("00:59:00"), "bbb"
End Sub
Sub bbb()
MsgBox "已开机1小时,请休息!"
Call aaa
End Sub







用EXCEL进行语音提醒(VBA 定时 播放)

此段代码放入SHEET1代码窗
Private Sub Worksheet_Change(ByVal Target As Range)
tim '利用CHANGE事件执行TIM过程,即在当前工作表发生修改后触发
End Sub

Private Declare Function mciExecute Lib "winmm.dll" (ByVal lpstrCommand As String) As Long

此段代码放入模块代码窗
Sub auto_open() '打开EXCEL后执行TIM过程
tim
End Sub
Sub tim()
Dim StarTime As Single
StarTime = Timer + 10 '设定每十秒钟执行BF过程
Do While Timer < StarTime
DoEvents
Loop
Call bf
End Sub

Sub bf()
Dim rng As Range
For Each rng In Sheets("sheet1").Range("B3:B17") '加载B3:B7单元格内容到RNG
If rng = Date Then '假如加载单元内日期为今天
If 24 * 24 * (rng.Offset(0, -1) - Time) < -1 Then rng.EntireRow.Interior.ColorIndex = xlNone '小于当前时间一小时则当前列为空白底色
If 24 * (rng.Offset(0, -1) - Time) < 1 And 24 * (rng.Offset(0, -1) - Time) > 0 Then rng.EntireRow.Interior.ColorIndex = 6 '如果一小时内当前列为黄色
If 24 * (rng.Offset(0, -1) - Time) > -0.01 And 24 * (rng.Offset(0, -1) - Time) < 0.01 Then '单元格时间约在当前时间一分钟内执行
rng.EntireRow.Interior.ColorIndex = 3 '当前列为红色
songplay '执行SONGPLAY过程
Else
If 24 * (rng.Offset(0, -1) - Time) > -1 And 24 * (rng.Offset(0, -1) - Time) < 0 Then '当前单元格时间在当前一小时前底色为红
rng.EntireRow.Interior.ColorIndex = 3
End If
End If
End If
Next
tim '循环执行TIM过程
End Sub

Sub songplay()
ReturnSoundValue = mciExecute("play" & ThisWorkbook.Path & "\1.wav") '播放当前文件所在文件夹内的1.WAV声音文件
End Sub


参考附件
定时.rar



用EXCEL进行语音提醒(VBA 定时 播放)
此段代码放入SHEET1代码窗
Private Sub Worksheet_Change(ByVal Target As Range)
tim '利用CHANGE事件执行TIM过程,即在当前工作表发生修改后触发
End Sub
Private Declare Function mciExecute Lib "winmm.dll" (ByVal lpstrCommand As String) As Long
此段代码放入模块代码窗
Sub auto_open() '打开EXCEL后执行TIM过程
tim
End Sub
Sub tim()
Dim StarTime As Single
StarTime = Timer + 10 '设定每十秒钟执行BF过程
Do While Timer < StarTime
DoEvents
Loop
Call bf
End Sub
Sub bf()
Dim rng As Range
For Each rng In Sheets("sheet1").Range("B3:B17") '加载B3:B7单元格内容到RNG
If rng = Date T

hen '假如加载单元内日期为今天
If 24 * 24 *
(rng.Offset(0, -1) - Time) < -1 Then rng.EntireRow.Interior.ColorIndex = xlNone '小于当前时间一小时则当前列为空白底色
If 24 * (rng.Offset(0, -1) - Time) < 1 And 24 * (rng.Offset(0, -1) - Time) > 0 Then rng.EntireRow.Interior.ColorIndex = 6 '如果一小时内当前列为黄色
If 24 * (rng.Offset(0, -1) - Time) > -0.01 And 24 * (rng.Offset(0, -1) - Time) < 0.01 Then '单元格时间约在当前时间一分钟内执行
rng.EntireRow.Interior.ColorIndex = 3 '当前列为红色
songplay '执行SONGPLAY过程
Else
If 24 * (rng.Offset(0, -1) - Time) > -1 And 24 * (rng.Offset(0, -1) - Time) < 0 Then '当前单元格时间在当前一小时前底色为红
rng.EntireRow.Interior.ColorIndex = 3
End If
End If
End If
Next
tim '循环执行TIM过程
End Sub
Sub songplay()
ReturnSoundValue = mciExecute("play" & ThisWorkbook.Path & "\1.wav") '播放当前文件所在文件夹内的1.WAV声音文件
End Sub






相关主题