高手求助,VBA每隔一段时间重复执行某个程序

发布网友 发布时间：2022-04-24 02:54

我来回答

共1个回答

热心网友 时间：2023-10-23 05:04

1. OnTime方法
Public Declare PtrSafe Function PlayWaveSound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszsoundname As String, ByVal uflags As Long) As Long
Sub run_timer()
    Application.OnTime Now + TimeValue("00:00:03"), "showmsg"
End Sub
Sub showmsg()
    Dim i As Integer
    Dim soundName As String
    soundName = "C:\WINDOWS\Media\Windows Ding.wav"    '指定声音文件
    PlayWaveSound soundName, 1  '0: 放完声音再往下执行/ 1: 立即往下执行
    MsgBox "现在时间：" & Now, , "现在时间"
End Sub

2.VBA调用winapi 计时器方法 
（位系统使用）
Private Declare PtrSafe Function SetTimer Lib "user32.dll" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr, ByVal uElapse As LongPtr, ByVal lpTimerFunc As LongPtr) As LongPtr
Private Declare PtrSafe Function KillTimer Lib "user32.dll" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr) As LongPtr
Public Declare PtrSafe Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Public hMain As LongPtr
Sub OnTime1()
    frmCheck.lblTime.Caption = Format(Now, "hh:mm:ss")
End Sub

Public Sub enableTimer()
    SetTimer hMain, 1001, 1000, AddressOf OnTime1
End Sub

Public Sub DisableTimer()
    KillTimer hMain, 1001
End Sub

热心网友 时间：2023-11-14 06:01

1. OnTime方法
Public Declare PtrSafe Function PlayWaveSound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszsoundname As String, ByVal uflags As Long) As Long
Sub run_timer()
    Application.OnTime Now + TimeValue("00:00:03"), "showmsg"
End Sub
Sub showmsg()
    Dim i As Integer
    Dim soundName As String
    soundName = "C:\WINDOWS\Media\Windows Ding.wav"    '指定声音文件
    PlayWaveSound soundName, 1  '0: 放完声音再往下执行/ 1: 立即往下执行
    MsgBox "现在时间：" & Now, , "现在时间"
End Sub

2.VBA调用winapi 计时器方法 
（位系统使用）
Private Declare PtrSafe Function SetTimer Lib "user32.dll" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr, ByVal uElapse As LongPtr, ByVal lpTimerFunc As LongPtr) As LongPtr
Private Declare PtrSafe Function KillTimer Lib "user32.dll" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr) As LongPtr
Public Declare PtrSafe Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Public hMain As LongPtr
Sub OnTime1()
    frmCheck.lblTime.Caption = Format(Now, "hh:mm:ss")
End Sub

Public Sub enableTimer()
    SetTimer hMain, 1001, 1000, AddressOf OnTime1
End Sub

Public Sub DisableTimer()
    KillTimer hMain, 1001
End Sub

热心网友 时间：2023-11-14 06:01

1. OnTime方法
Public Declare PtrSafe Function PlayWaveSound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszsoundname As String, ByVal uflags As Long) As Long
Sub run_timer()
    Application.OnTime Now + TimeValue("00:00:03"), "showmsg"
End Sub
Sub showmsg()
    Dim i As Integer
    Dim soundName As String
    soundName = "C:\WINDOWS\Media\Windows Ding.wav"    '指定声音文件
    PlayWaveSound soundName, 1  '0: 放完声音再往下执行/ 1: 立即往下执行
    MsgBox "现在时间：" & Now, , "现在时间"
End Sub

2.VBA调用winapi 计时器方法 
（位系统使用）
Private Declare PtrSafe Function SetTimer Lib "user32.dll" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr, ByVal uElapse As LongPtr, ByVal lpTimerFunc As LongPtr) As LongPtr
Private Declare PtrSafe Function KillTimer Lib "user32.dll" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr) As LongPtr
Public Declare PtrSafe Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Public hMain As LongPtr
Sub OnTime1()
    frmCheck.lblTime.Caption = Format(Now, "hh:mm:ss")
End Sub

Public Sub enableTimer()
    SetTimer hMain, 1001, 1000, AddressOf OnTime1
End Sub

Public Sub DisableTimer()
    KillTimer hMain, 1001
End Sub