Application.Ontime只能实现秒级定时,毫秒级定时器需要调用API函数。
例:A1单元格每10毫秒随机出现1-100,VBA代码:
#If Win64 Then
Private Declare PtrSafe Function SetTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long, _
ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As Long
Private Declare PtrSafe Function KillTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long) As Long
#Else
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
#End If
'64位操作系统API函数声明与X86操作系统API函数声明。
'声明TimerID用于存放定时器的ID。
Public TimerID As Long
'启动定时器。Duration是定时器触发的时间,单位为毫秒。
Sub StartTimer(ByVal Duration As Long)
If TimerID = 0 Then
TimerID = SetTimer(0, 0, Duration, AddressOf OnTimer)
Else
Call StopTimer
TimerID = SetTimer(0, 0, Duration, AddressOf OnTimer)
End If
End Sub
'停止定时器。
Sub StopTimer()
KillTimer 0, TimerID
End Sub
'必须忽视错误,否则会弹出错误提示。
Sub OnTimer()
On Error GoTo line
Call StartTimer(10)
Cells(1, 1).Value = Int(100 * Rnd) + 1
line:
End Sub
效果演示图:

开始按钮链接OnTimer,暂停按钮链接 StopTimer
例:A1单元格每10毫秒随机出现1-100,VBA代码:
#If Win64 Then
Private Declare PtrSafe Function SetTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long, _
ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As Long
Private Declare PtrSafe Function KillTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long) As Long
#Else
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
#End If
'64位操作系统API函数声明与X86操作系统API函数声明。
'声明TimerID用于存放定时器的ID。
Public TimerID As Long
'启动定时器。Duration是定时器触发的时间,单位为毫秒。
Sub StartTimer(ByVal Duration As Long)
If TimerID = 0 Then
TimerID = SetTimer(0, 0, Duration, AddressOf OnTimer)
Else
Call StopTimer
TimerID = SetTimer(0, 0, Duration, AddressOf OnTimer)
End If
End Sub
'停止定时器。
Sub StopTimer()
KillTimer 0, TimerID
End Sub
'必须忽视错误,否则会弹出错误提示。
Sub OnTimer()
On Error GoTo line
Call StartTimer(10)
Cells(1, 1).Value = Int(100 * Rnd) + 1
line:
End Sub
效果演示图:

开始按钮链接OnTimer,暂停按钮链接 StopTimer