VBA 定时器

最新推荐文章于 2024-08-30 03:38:20 发布

liang890319

最新推荐文章于 2024-08-30 03:38:20 发布

阅读量8.4k

点赞数

分类专栏：玩转VB 文章标签： vba windows application api 任务工具

玩转VB 专栏收录该内容

28 篇文章 2 订阅

订阅专栏

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