• 博客园logo
  • 会员
  • 众包
  • 新闻
  • 博问
  • 闪存
  • 赞助商
  • HarmonyOS
  • Chat2DB
    • 搜索
      所有博客
    • 搜索
      当前博客
  • 写随笔 我的博客 短消息 简洁模式
    用户头像
    我的博客 我的园子 账号设置 会员中心 简洁模式 ... 退出登录
    注册 登录
养眼大魔王
博客园    首页    新随笔    联系   管理    订阅  订阅

VBA中使用计时器的两种方法

'================================
' VBA采用Application.OnTime实现计时器
'
' http://www.cnhup.com
'================================
Public RunWhen As Double
Public Const cRunIntervalSeconds = 120 ' two minutes
Public Const cRunWhat = "TheSub"  ' the name of the procedure to run
Sub StartTimer()
    RunWhen = Now + TimeSerial(0,0,cRunIntervalSeconds)
    Application.OnTime EarliestTime:=RunWhen, Procedure:=cRunWhat, _
        Schedule:=True
End Sub
Sub TheSub()
    StartTimer  ' Reschedule the procedure
End Sub
Sub StopTimer()
    On Error Resume Next
    Application.OnTime EarliestTime:=RunWhen,Procedure:=cRunWhat, _
        Schedule:=False
End Sub
'================================
' VBA采用Windows API实现计时器
'
' http://www.cnhup.com
'================================
Public Declare Function SetTimer Lib "user32" ( _
    ByVal HWnd As Long, _
    ByVal nIDEvent As Long, _
    ByVal uElapse As Long, _ 
    ByVal lpTimerFunc As Long) As Long

Public Declare Function KillTimer Lib "user32" ( _
    ByVal HWnd As Long, _
    ByVal nIDEvent As Long) As Long

Public TimerID As Long
Public TimerSeconds As Single

Sub StartTimer()
    TimerSeconds = 1 ' how often to "pop" the timer.
    TimerID = SetTimer(0&, 0&, TimerSeconds * 1000&, AddressOf TimerProc)
End Sub

Sub EndTimer()
    On Error Resume Next
    KillTimer 0&, TimerID
End Sub

Sub TimerProc(ByVal HWnd As Long, ByVal uMsg As Long, _
        ByVal nIDEvent As Long, ByVal dwTimer As Long)
    
    ''''''
    ' This procedure is called by Windows. Put your
    ' code here.
    ''''''
End Sub

 

posted @ 2016-12-01 14:48  养眼大魔王  阅读(15051)  评论(0)    收藏  举报
刷新页面返回顶部
博客园  ©  2004-2025
浙公网安备 33010602011771号 浙ICP备2021040463号-3