Office中国论坛/Access中国论坛

标题: 求助时间差问题！ [打印本页]

作者: jxcxf8100 时间: 2010-4-23 07:52
标题: 求助时间差问题！
想在VBA中实现当前时间NOW()与单元格中设定时间相差五分钟，也就是如A1中为12:00:00，当系统时间为11:55:00时，产生声音报警。我是初学者，呵呵，请高手给予解答为盼，谢谢。
附VBA程序和附件如下：

Private Declare Function PlaySound Lib "winmm.dll" Alias "PlaySoundA" (ByVal lpszName As String, ByVal hModule As Long, ByVal dwFlags As Long) As Long
Private Const SND_ALIAS& = &H10000
Private Const SND_ASYNC& = &H1
Private Const SND_SYNC& = &H0
Private Const SND_NODEFAULT& = &H2
Private Const SND_FILENAME& = &H20000
Private Const SND_LOOP& = &H8
Private Const SND_PURGE& = &H40
Public Const sdDefault = ".Default"
Public Const sdClose = "Close"
Public Const sdEmptyRecycleBin = "EmptyRecycleBin"
Public Const sdMailBeep = "MailBeep"
Public Const sdMaximize = "Maximize"
Public Const sdMenuCommand = "MenuCommand"
Public Const sdMenuPopUp = "MenuPopup"
Public Const sdMinimize = "Minimize"
Public Const sdOpen = "Open"
Public Const sdSystemExclaimation = "SystemExclaimation"
Public Const sdSystemExit = "SystemExit"
Public Const sdSystemHand = "SystemHand"
Public Const sdSystemQuestion = "SystemQuestion"
Public Const sdSystemStart = "SystemStart"
Sub playSystemSound()
Call PlaySound(sdSystemStart, 0&, SND_ALIAS Or SND_ASYNC Or SND_NODEFAULT)
End Sub
Sub PlayWavLoop1()
Call PlaySound(ThisWorkbook.Path & "\trysound.wav", 0&, SND_ASYNC Or SND_LOOP Or SND_NODEFAULT)
WaitMinorSec 5
Call PlaySound(vbNullString, 0&, SND_NODEFAULT)
End Sub
Sub PlayWavLoop2()
Call PlaySound(ThisWorkbook.Path & "\trysound.wav", 0&, SND_ASYNC Or SND_LOOP Or SND_NODEFAULT)
WaitMinorSec 5
Call PlaySound("", 0&, SND_PURGE)
End Sub
Sub PlayWavTest1()
Call PlaySound(ThisWorkbook.Path & "\trysound.wav", 0&, SND_ASYNC Or SND_NODEFAULT)
Call PlaySound(vbNullString, 0&, SND_NODEFAULT)
End Sub
Sub PlayWavTest2()
Call PlaySound(ThisWorkbook.Path & "\trysound.wav", 0&, SND_ASYNC Or SND_NODEFAULT)
Call PlaySound("", 0&, SND_NODEFAULT)
End Sub
Public Sub WaitMinorSec(ByVal dms As Double)
Dim sTimer As Date
sTimer = Timer
Do
DoEvents
Loop While Format((Timer - sTimer), "0.000") < dms
End Sub

我应该在该程序中如何添加，才能实现此功能，谢谢了。[attach]42055[/attach]

作者: 方漠 时间: 2010-4-23 10:48
FYI.  注意A1单元格里光输入一个时间是不够的,一定要输入日期+时间,至于为什么,自己研究一下EXCEL的日期时间是以什么格式存储的就知道.

Public Declare Function PlaySound Lib "winmm.dll" Alias "PlaySoundA" (ByVal lpszName As String, ByVal hModule As Long, ByVal dwFlags As Long) As Long

Sub TestPlay()

Dim DD As Date

DD = [A1]
Do

If DateDiff("n", Now(), DD) <= 5 Then
   PlaySound ThisWorkbook.Path & "\trysound.wav", 0&, &H1
End If

DoEvents

Loop While DateDiff("n", Now(), DD) >= 2

End Sub

作者: jxcxf8100 时间: 2010-4-24 06:40
版主您好：我把您的代码粘贴到第一个工作表中，是通用的，然后出现了编绎错误[常数、固定长度字符串、数组、用户定义类型愉及Dedare语句不允许作为对象模块的公共成员]
另外，我为什么不能把now()-today()应用在您的公式中。
谢谢你！

我还想把语音录制成分段的，然后比如把当前时间分解后，用语音播报出来，比如13：20，1对应1.wav，3对应3.wav，2对应2.wav，然后顺序播放就行了，这个能实现吗？怎么用数组的方法进行组合，能给编个代码吗？

作者: 方漠 时间: 2010-4-26 14:48
"版主您好：我把您的代码粘贴到第一个工作表中，是通用的，然后出现了编绎错误[常数、固定长度字符串、数组、用户定义类型愉及Dedare语句不允许作为对象模块的公共成员]
另外，我为什么不能把now()-today()应用在您的公式中。"

请新建一个模块,COPY我的代码再试一下.

我用的DATEDIFF函数,只在VBA中能用, 工作表中不可用. now()-today()这个求出来的不是分钟.NOW返回当前日期时间, TODAY只返回当前日期.

作者: jxcxf8100 时间: 2010-4-29 16:33
您能把上面的逐语句给我解释下吗？我真的很笨，但我很执着，我是初学者，谢谢您。我还是没弄清楚，本来在家的时间不长，一月能在家间休五天左右，呵呵。这个问题困扰我很久了！！！

作者: 方漠 时间: 2010-5-1 10:24
Public Declare Function PlaySound Lib "winmm.dll" Alias "PlaySoundA" (ByVal lpszName As String, ByVal hModule As Long, ByVal dwFlags As Long) As Long

'声明调用API函数 Playsound

Sub TestPlay()

Dim DD As Date '定义函数DD为日期型数据

DD = [A1] 'DD等于A1单元格输入的日期时间

  Do '开始循环

If DateDiff("n", Now(), DD) <= 5 Then    '如果系统当前时间与DD的时间间隔小于等于5分钟, Playsound
   PlaySound ThisWorkbook.Path & "\trysound.wav", 0&, &H1
End If

DoEvents    '响应用户控制

Loop While DateDiff("n", Now(), DD) >= 2    '如果系统当前时间与DD的时间间隔大于等于2分钟, 继续循环,即会连续PlaySound 3分钟

End Sub

欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/)