vba Excel VBA中用户表单上的计时器
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/1562913/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Timer on user form in Excel VBA
提问by Don Kirkby
I've got some old Excel VBA code where I want to run a task at regular intervals. If I were using VB6, I would have used a timer control.
我有一些旧的 Excel VBA 代码，我想在其中定期运行任务。如果我使用 VB6，我会使用计时器控件。
I found the Application.OnTime()method, and it works well for code that's running in an Excel worksheet, but I can't make it work in a user form. The method never gets called.
我找到了Application.OnTime()方法，它适用于在 Excel 工作表中运行的代码，但我无法使其在用户表单中工作。该方法永远不会被调用。
How can I make Application.OnTime() call a method in a user form, or are there other ways to schedule code to run in VBA?
如何让 Application.OnTime() 调用用户表单中的方法，或者是否有其他方法可以安排代码在 VBA 中运行？
回答by Don Kirkby
I found a workaround for this. If you write a method in a module that just calls a method in your user form, then you can schedule the module method using Application.OnTime().
我找到了一个解决方法。如果你在一个模块中编写一个方法来调用你的用户表单中的一个方法，那么你可以使用 Application.OnTime() 来调度模块方法。
Kind of a kludge, but it'll do unless somebody has a better suggestion.
有点混乱，但除非有人有更好的建议，否则它会做。
Here's an example:
下面是一个例子：
''//Here's the code that goes in the user form
Dim nextTriggerTime As Date
Private Sub UserForm_Initialize()
ScheduleNextTrigger
End Sub
Private Sub UserForm_Terminate()
Application.OnTime nextTriggerTime, "modUserformTimer.OnTimer", Schedule:=False
End Sub
Private Sub ScheduleNextTrigger()
nextTriggerTime = Now + TimeValue("00:00:01")
Application.OnTime nextTriggerTime, "modUserformTimer.OnTimer"
End Sub
Public Sub OnTimer()
''//... Trigger whatever task you want here
''//Then schedule it to run again
ScheduleNextTrigger
End Sub
''// Now the code in the modUserformTimer module
Public Sub OnTimer()
MyUserForm.OnTimer
End Sub
回答by ashleedawg
I needed a visible countdown timer that could stay on top of other windows and run smoothly whether making changes to the workbook, or minimizing the Excel window. So, I adapted the @don-kirkby's creative code abovefor my own purposes and figured I'd share the result.
??????????????????????
The code below requires creation of a module and a userform as noted in the comments, or you can download the .xlsmat the bottom of this answer.
我需要一个可见的倒数计时器，无论是对工作簿进行更改，还是最小化 Excel 窗口，它都可以停留在其他窗口的顶部并且平稳运行。因此，我根据自己的目的改编了上面@don-kirkby 的创意代码，并认为我会分享结果。
????????????????????????
下面的代码需要创建一个模块和一个用户表单，如评论中所述，或者您可以下载此答案底部的 。.xlsm
I used the Windows Timer APIfor more accurate and smooth countdown (and also customizable down to ~100 millisecond timer resolution, depending on your processor. There's even a "tick tock" sound. ?
我使用了Windows Timer API来实现更准确和平滑的倒计时（并且还可以自定义低至约 100 毫秒的计时器分辨率，具体取决于您的处理器。甚至还有“滴答”声。？
Insert a new module and save it as modUserFormTimer. Add two form control command buttonsto the worksheet, labelled Start Timerand Stop Timerand assignedprocedures btnStartTimer_Clickand btnStopTimer_Click.
插入一个新模块并将其另存为modUserFormTimer. 添加两个表单控件命令按钮到工作表中，标有Start Timer与Stop Timer和分配程序btnStartTimer_Click和btnStopTimer_Click。
Option Explicit 'modUserFormTimer
Public Const showTimerForm = True 'timer runs with/without the userform showing
Public Const playTickSound = True 'tick tock (a WAV sounds could be embedded: `https:// goo.gl/ ReuUyd`)
Public Const timerDuration = "00:00:20" 'could also Insert>Object a WAV for tick or alarm
Public Const onTimerStart_MinimizeExcel = True 'minimize Excel? (countdown remains visible)
Public Const onTimerStart_MaximizeExcel = True 'maximize Excel when timer completes?
'timer could be on top of other applications; instructions here: `https:// goo.gl/ AgmWrM`
'safe for 32 or 64 bit Office:
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
Public Declare PtrSafe Function Beep Lib "kernel32" (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long
Public schedTime As Date 'this is the "major" timer set date
Private m_TimerID As Long
Public Sub OnTimerTask()
'the procedure that runs on completion of the "major timer" (timer won't reschedule)
Unload frmTimer
''''''''''''''''''''''''''''''
MsgBox "Do Something!" ' < < < < < Do Something Here
''''''''''''''''''''''''''''''
End Sub
Public Sub btnStartTimer_Click()
schedTime = Now() + TimeValue(timerDuration)
InitTimerForm
End Sub
Public Sub btnStopTimer_Click()
'clicking the 'x' on the userform also ends the timer (disable the close button to force continue)
schedTime = 0
frmTimer.UserForm_Terminate
End Sub
Public Sub InitTimerForm()
'run this procedure to start the timer
frmTimer.OnTimer
Load frmTimer
If showTimerForm Then
If onTimerStart_MinimizeExcel Then Application.WindowState = xlMinimized
frmTimer.Show 'timer will still work if userform is hidden (could add a "hide form" option)
End If
End Sub
Public Sub StartTimer(ByVal Duration As Long)
'Begin Millisecond Timer using Windows API (called by UserForm)
If m_TimerID = 0 Then
If Duration > 0 Then
m_TimerID = SetTimer(0, 0, Duration, AddressOf TimerEvent)
If m_TimerID = 0 Then
MsgBox "Timer initialization failed!", vbCritical, "Timer"
End If
Else
MsgBox "The duration must be greater than zero.", vbCritical, "Timer"
End If
Else
MsgBox "Timer already started.", vbInformation, "Timer"
End If
End Sub
Public Sub StopTimer()
If m_TimerID <> 0 Then 'check if timer is active
KillTimer 0, m_TimerID 'it's active, so kill it
m_TimerID = 0
End If
End Sub
Private Sub TimerEvent()
'the API calls this procedure
frmTimer.OnTimer
End Sub
Next, create a userform, save it as frmTimer. Add a text box named txtCountdown. Set property ShowModalto False. Paste the following into the form's code window:
接下来，创建一个用户表单，将其另存为frmTimer. 添加一个名为 的文本框txtCountdown。将属性设置ShowModal为False. 将以下内容粘贴到表单的代码窗口中：
Option Explicit 'code for userform "frmTimer"
'requires a textbox named "txtCountdown" and "ShowModal" set to False.
Dim nextTriggerTime As Date
Private Sub UserForm_Initialize()
ScheduleNextTrigger
End Sub
Public Sub UserForm_Terminate()
StopTimer
If schedTime > 0 Then
schedTime = 0
End If
If onTimerStart_MaximizeExcel Then Application.WindowState = xlMaximized 'maximize excel window
Unload Me
End Sub
Private Sub ScheduleNextTrigger() 'sets the "minor" timer (for the countdown)
StartTimer (1000) 'one second
End Sub
Public Sub OnTimer()
'either update the countdown, or fire the "major" timer task
Dim secLeft As Long
If Now >= schedTime Then
OnTimerTask 'run "major" timer task
Unload Me 'close userForm (won't schedule)
Else
secLeft = CLng((schedTime - Now) * 60 * 60 * 24)
If secLeft < 60 Then 'under 1 minute (don't show mm:ss)
txtCountdown = secLeft & " sec"
Else
'update time remaining in textbox on userform
If secLeft > 60 * 60 Then
txtCountdown = Format(secLeft / 60 / 60 / 24, "hh:mm:ss")
Else 'between 59 and 1 minutes remain:
txtCountdown = Right(Format(secLeft / 60 / 60 / 24, "hh:mm:ss"), 5)
End If
End If
If playTickSound Then Beep 16000, 65 'tick sound
End If
End Sub
Download the demo .xksm.here. There are numerous ways this can be customized or adapted to specific needs. I'm going to use it to calculated and display real time statistics from a popular Q&A site in the corner of my screen...
在.xksm.此处下载演示。有多种方式可以定制或适应特定需求。我将使用它来计算和显示来自屏幕角落的热门问答网站的实时统计数据...
Notethat, since it contains VBA macro's, the file could may set off your virus scanner (as with any other non-local file with VBA). If you're concerned, don't download, and instead build it yourself with the information provided.)
请注意，由于它包含 VBA 宏，该文件可能会触发您的病毒扫描程序（与任何其他具有 VBA 的非本地文件一样）。如果您担心，请不要下载，而是使用提供的信息自行构建。）
回答by kris
Thanks to user1575005 !!
感谢 user1575005 ！！
Used the code in a Module to setup a Timer() process:
使用模块中的代码来设置 Timer() 进程：
Dim nextTriggerTime As Date
Dim timerActive As Boolean
Public Sub StartTimer()
Debug.Print Time() & ": Start"
If timerActive = False Then
timerActive = True
Call ScheduleNextTrigger
End If
End Sub
Public Sub StopTimer()
If timerActive = True Then
timerActive = False
Application.OnTime nextTriggerTime, "OnTimer", Schedule:=False
End If
Debug.Print Time() & ": End"
End Sub
Private Sub ScheduleNextTrigger()
If timerActive = True Then
nextTriggerTime = Now + TimeValue("00:00:10")
Application.OnTime nextTriggerTime, "OnTimer"
End If
End Sub
Public Sub OnTimer()
Call bus_OnTimer
Call ScheduleNextTrigger
End Sub
Public Sub bus_OnTimer()
Debug.Print Time() & ": Tick"
Call doWhateverUwant
End Sub
Private Sub doWhateverUwant()
End Sub
回答by user1575005
How about moving all the code to a 'Timer' module.
将所有代码移动到“计时器”模块如何。
Dim nextTriggerTime As Date
Dim timerActive As Boolean
Public Sub StartTimer()
If timerActive = False Then
timerActive = True
Call ScheduleNextTrigger
End If
End Sub
Public Sub StopTimer()
If timerActive = True Then
timerActive = False
Application.OnTime nextTriggerTime, "Timer.OnTimer", Schedule:=False
End If
End Sub
Private Sub ScheduleNextTrigger()
If timerActive = True Then
nextTriggerTime = Now + TimeValue("00:00:01")
Application.OnTime nextTriggerTime, "Timer.OnTimer"
End If
End Sub
Public Sub OnTimer()
Call MainForm.OnTimer
Call ScheduleNextTrigger
End Sub
Now you can call from the mainform:
现在您可以从主窗体调用：
call Timer.StartTimer
call Timer.StopTimer
To prevent errors, add:
为防止错误，请添加：
Private Sub UserForm_Terminate()
Call Timer.StopTimer
End Sub
Wich will trigger:
将触发：
Public Sub OnTimer()
Debug.Print "Tick"
End Sub
