咨询一下VBA当中如何使用Timer控件，比如说每隔5分钟发一个Msgbox
最好是期间Excel能够进行其他的操作，有的代码实现了每隔5分钟发一个Msgbox的功能，但在等待的这5分钟里面，Excel是被独占住的，无法进行其他的操作，只能等待，这就不大有用了
VBA不支持Timer控件，需要自己写一个与Timer控件功能相同的类模块。
代码如下：
CTimer.cls模块
Option Explicit
Private iInterval As Long
Private id As Long
Public Item As Variant
Public Event ThatTime()
Public Enum EErrorTimer
eeBaseTimer = 13650
eeTooManyTimers
eeCantCreateTimer
End Enum
Friend Sub ErrRaise(e As Long)
Dim sText As String, sSource As String
If e > 1000 Then
sSource = "实例过程"
Select Case e
Case eeTooManyTimers
sText = "不允许超过100个定时器"
Case eeCantCreateTimer
sText = "不能建立系统定时器"
End Select
Err.Raise e Or vbObjectError, sSource, sText
Else
Err.Raise e, sSource
End If
End Sub
Property Get Interval() As Long
Interval = iInterval
End Property
Property Let Interval(iIntervalA As Long)
Dim f As Boolean
If iInterval = iIntervalA Then Exit Property
If iIntervalA Then
If iInterval Then
f = TimerDestroy(Me)
End If
iInterval = iIntervalA
If TimerCreate(Me) = False Then ErrRaise eeCantCreateTimer
Else
If iInterval Then
iInterval = iIntervalA
f = TimerDestroy(Me)
End If
End If
End Property
Public Sub PulseTimer()
RaiseEvent ThatTime
End Sub
Friend Property Get TimerID() As Long
TimerID = id
End Property
Friend Property Let TimerID(idA As Long)
id = idA
End Property
Private Sub Class_Initialize()
'Debug.Print "定时器初始化"
End Sub
Private Sub Class_Terminate()
If Interval Then Interval = 0
'Debug.Print "终止定时器"
End Sub
MTimer.bas模块：
Option Explicit
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (dest As _
Any, source As Any, ByVal bytes As Long)
Private Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal _
lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
Const cTimerMax = 100
Private Type TTimerData
idTimer As Long
pTimer As Long
End Type
Public atdata(1 To cTimerMax) As TTimerData
Private cTimers As Long
Function TimerCreate(timer As CTimer) As Boolean
If cTimers + 1 = cTimerMax Then timer.ErrRaise eeTooManyTimers
timer.TimerID = SetTimer(0&, 0&, timer.Interval, AddressOf TimerProc)
If timer.TimerID Then
TimerCreate = True
cTimers = cTimers + 1
atdata(cTimers).idTimer = timer.TimerID
atdata(cTimers).pTimer = ObjPtr(timer)
Else
TimerCreate = False
timer.TimerID = 0
timer.Interval = 0
End If
End Function
Public Function TimerDestroy(timer As CTimer) As Long
Dim i As Long, iDead As Long, tdata As TTimerData ' = zeros
For i = 1 To cTimers
If timer.TimerID = atdata(i).idTimer Then
Call KillTimer(0, timer.TimerID)
cTimers = cTimers - 1
For iDead = i To cTimers
atdata(iDead) = atdata(iDead + 1)
Next
atdata(cTimers + 1) = tdata
TimerDestroy = True
Exit Function
End If
Next
End Function
Sub TimerProc(ByVal hwnd As Long, ByVal uMsg As Long, _
ByVal idEvent As Long, ByVal dwTime As Long)
Dim i As Integer, timer As CTimer
For i = 1 To cTimers
If idEvent = atdata(i).idTimer Then
CopyMemory timer, atdata(i).pTimer, 4
timer.PulseTimer
CopyMemory timer, 0&, 4
Exit Sub
End If
Next
End Sub
然后你就可以在VBA中声明这个类对象，访问它的公共属性和事件。
