Excel VBA定时器无法停止，触发重复事件及运行时错误1004求助

问题根源 #

1. 重复触发：未添加运行状态标记，多次点击启动按钮会重复创建Application.OnTime事件，导致叠加执行
2. 停止冻结+1004错误：未精确保存Timer的调度时间，取消时参数不匹配；或Timer回调过程正在操作Excel对象时被强行中断，引发资源锁定

修正后的完整代码 #

标准模块（Module1）顶部全局声明 #

' 标记Timer是否正在运行，阻止重复触发
Public isTimerRunning As Boolean
' 保存Timer的下一次调度时间，用于精确取消
Public nextRunTime As Date

启动按钮宏 #

Sub StartTimer1()
    ' 如果Timer已在运行，直接退出，避免重复触发
    If isTimerRunning Then Exit Sub
    
    ' 设置运行标记
    isTimerRunning = True
    ' 首次拉取数据
    PullData
    ' 调度下一次执行（这里设为5秒间隔，可自行调整）
    nextRunTime = Now + TimeValue("00:00:05")
    Application.OnTime nextRunTime, "PullData"
End Sub

停止按钮宏 #

Sub StopTimer1()
    ' 先检查Timer是否在运行
    If Not isTimerRunning Then Exit Sub
    
    On Error Resume Next ' 防止时间已过导致的取消失败报错
    ' 精确取消已调度的Timer事件
    Application.OnTime nextRunTime, "PullData", , False
    On Error GoTo 0
    
    ' 重置运行标记
    isTimerRunning = False
    ' 恢复屏幕刷新（如果拉取过程中关闭了）
    Application.ScreenUpdating = True
End Sub

拉取数据回调过程 #

Sub PullData()
    ' 防止重复进入（比如Timer间隔过短，上一次还没执行完）
    If Not isTimerRunning Then Exit Sub
    
    On Error GoTo Cleanup ' 错误捕获，避免崩溃
    
    ' 关闭屏幕刷新提升性能，同时防止操作过程中界面卡顿
    Application.ScreenUpdating = False
    
    ' --------------------------
    ' 这里写你的拉取数据逻辑，比如：
    Range("A1").Value = "拉取时间：" & Now()
    ' 示例：模拟拉取耗时操作，加DoEvents让Excel响应停止命令
    For i = 1 To 10000
        DoEvents
    Next i
    ' --------------------------
    
    ' 调度下一次执行
    nextRunTime = Now + TimeValue("00:00:05")
    Application.OnTime nextRunTime, "PullData"
    
Cleanup:
    ' 恢复屏幕刷新
    Application.ScreenUpdating = True
    ' 如果出现错误，自动停止Timer
    If Err.Number <> 0 Then
        isTimerRunning = False
        MsgBox "拉取数据出错：" & Err.Description
    End If
End Sub

关键优化点 #

• 全局状态标记：isTimerRunning确保同一时间只有一个Timer在运行，彻底解决重复触发问题
• 精确取消Timer：用nextRunTime保存每次调度的精确时间，避免因时间偏差导致的1004错误
• 错误处理与资源释放：拉取过程中加错误捕获，停止时恢复屏幕刷新，防止资源锁定导致的冻结
• DoEvents调用：在耗时操作中加入DoEvents，让Excel能响应停止按钮的命令，避免冻结

内容的提问来源于stack exchange，提问作者user20492695