VBA 定时器

最新推荐文章于 2025-12-02 10:17:15 发布

转载最新推荐文章于 2025-12-02 10:17:15 发布 · 8.9k 阅读

收录于

玩转VB

http://www.cnhup.com/index.php/archives/vba-scheduling-events-with-ontime-and-windows-timers/

VBA程序运行中，你可能需要自动执行某些代码或者定时执行某些计划任务，如自动保存，这就要使用定时器来完成。这里水文工具集给出VBA中使用计时器的两种方法，其一是使用Application对象的OnTime方法来运行任务，其二是通过Windows API函数来完成，具体实例如下：

一、采用Application.OnTime实现计时器的方式

 
   01.
   '================================
  
   02.
   ' VBA采用Application.OnTime实现计时器
  
   03.
   '
  
   04.
   ' http://www.cnhup.com
  
   05.
   '================================
  
   06.
   Public RunWhen As Double
  
   07.
   Public Const cRunIntervalSeconds = 120 ' two minutes
  
   08.
   Public Const cRunWhat = "TheSub"  ' the name of the procedure to run
  
   09.
   Sub StartTimer()
  
   10.
   RunWhen = Now + TimeSerial(0,0,cRunIntervalSeconds)
  
   11.
   Application.OnTime EarliestTime:=RunWhen, Procedure:=cRunWhat, _
  
   12.
   Schedule:=True
  
   13.
   End Sub
  
   14.
   Sub TheSub()
  
   15.
   StartTimer  ' Reschedule the procedure
  
   16.
   End Sub
  
   17.
   Sub StopTimer()
  
   18.
   On Error Resume Next
  
   19.
   Application.OnTime EarliestTime:=RunWhen,Procedure:=cRunWhat, _
  
   20.
   Schedule:=False
  
   21.
   End Sub

二、采用Windows API函数实现计时器的方式（注意代码要保存到模块中才能用）

 
   01.
   '================================
  
   02.
   ' VBA采用Windows API实现计时器
  
   03.
   '
  
   04.
   ' http://www.cnhup.com
  
   05.
   '================================
  
   06.
   Public Declare Function SetTimer Lib "user32" ( _
  
   07.
   ByVal HWnd As Long, _
  
   08.
   ByVal nIDEvent As Long, _
  
   09.
   ByVal uElapse As Long, _
  
   10.
   ByVal lpTimerFunc As Long) As Long
  
   11.
    
   12.
   Public Declare Function KillTimer Lib "user32" ( _
  
   13.
   ByVal HWnd As Long, _
  
   14.
   ByVal nIDEvent As Long) As Long
  
   15.
    
   16.
   Public TimerID As Long
  
   17.
   Public TimerSeconds As Single
  
   18.
    
   19.
   Sub StartTimer()
  
   20.
   TimerSeconds = 1 ' how often to "pop" the timer.
  
   21.
   TimerID = SetTimer(0&, 0&, TimerSeconds * 1000&, AddressOf TimerProc)
  
   22.
   End Sub
  
   23.
    
   24.
   Sub EndTimer()
  
   25.
   On Error Resume Next
  
   26.
   KillTimer 0&, TimerID
  
   27.
   End Sub
  
   28.
    
   29.
   Sub TimerProc(ByVal HWnd As Long, ByVal uMsg AsLong, _
  
   30.
   ByVal nIDEvent As Long, ByVal dwTimer AsLong)
  
   31.
    
   32.
   ''''''
  
   33.
   ' This procedure is called by Windows. Put your
  
   34.
   ' code here.
  
   35.
   ''''''
  
   36.
   End Sub

标签

#vba #windows #application #api #任务