时间戳

首页 > 解决方案 > 即使 Application.On 时间安排已关闭，Excel 文件也会一直打开

excel - 即使 Application.On 时间安排已关闭，Excel 文件也会一直打开

问题描述

我希望有人可以帮助我解决我遇到的问题。我创建了工作簿，而不是打开开始几个宏：

Refresh_time - 每秒运行一次以更新时间计数器

Save_it - 每 30 分钟保存一次文件

订单 - 在特定时间运行 marco Save_order，02、10 和 18 小时

如果 10 分钟内没有任何活动，很少有 marcos 会关闭文件。

在这两种情况下，如果文件由于不活动或手动关闭而关闭，它会自行打开。

有人知道我在哪里犯了错误吗？

在本工作簿中

Private Sub Workbook_Open()

    Refresh_time
    Save_it
    Order
    TimeSetting

End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    On Error Resume Next
    
    Application.DisplayAlerts = False
    ActiveWorkbook.Save
    
    Stop_
    TimeStop
    
    On Error GoTo 0
    Application.DisplayAlerts = True

End Sub
 
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

   TimeStop
   TimeSetting

End Sub

在模块 1

Public dTimeB, dTimeS, dTimeT1, dTimeT2, dTimeT3, CloseTime As Date


Sub Stop_()


    Application.OnTime dTimeB, "Refresh_time", , False
    Application.OnTime dTimeS, "Save_it", , False
    Application.OnTime dTimeT1, "Save_order", , False
    Application.OnTime dTimeT2, "Save_order", , False
    Application.OnTime dTimeT3, "Save_order", , False
    
End Sub

Sub TimeSetting()


    On Error Resume Next
    Application.OnTime EarliestTime:=CloseTime, Procedure:="SavedAndClose", Schedule:=False
    On Error GoTo 0
    CloseTime = Now() + TimeValue("00:03:00")
    Application.OnTime EarliestTime:=CloseTime, Procedure:="SavedAndClose", Schedule:=True

End Sub
Sub TimeStop()

    On Error Resume Next

    Application.OnTime EarliestTime:=CloseTime, _
      Procedure:="SavedAndClose", Schedule:=False

 End Sub
Sub SavedAndClose()

    ActiveWorkbook.Close Savechanges:=True

End Sub

Sub Refresh_time()

    Dim Smena_1, Smena_2, Smena_3 As Date
    
    On Error Resume Next
    Application.OnTime EarliestTime:=dTimeB, Procedure:="Refresh_time", Schedule:=False
    On Error GoTo 0
    dTimeB = Now() + TimeValue("00:00:01")
    Application.OnTime EarliestTime:=dTimeB, Procedure:="Refresh_time", Schedule:=True
    
    Smena_1 = Date + TimeValue("10:00:00")
    Smena_2 = Date + TimeValue("18:00:00")
    Smena_3 = Date + 1 + TimeValue("02:00:00")
    vreme = Date + Time
    
    If vreme < Smena_1 Then
        Y = Smena_1 - vreme
        Else
        If vreme < Smena_2 Then
            Y = Smena_2 - vreme
            Else
                Y = Smena_3 - vreme
    
        End If
    End If
        Workbooks("Lager MES REO zica_MM.xlsm").Worksheets("Pocetna").Vreme_porucivanja.Value = Format(Y, "hh:mm:ss")
    
        Workbooks("Lager MES REO zica_MM.xlsm").Worksheets("Pocetna").Za_porucivanje.Value = Application.CountA(Workbooks("Lager MES REO zica_MM.xlsm").Worksheets("Za porucivanje").Range("A:A")) - 1

End Sub

Sub Save_it()

    Application.DisplayAlerts = False
    
    ThisWorkbook.Save
    
    Application.DisplayAlerts = True

    On Error Resume Next
    Application.OnTime EarliestTime:=dTimeS, Procedure:="Save_it", Schedule:=False
    On Error GoTo 0
    dTimeS = Now() + TimeValue("00:10:00")
    Application.OnTime EarliestTime:=dTimeS, Procedure:="Save_it", Schedule:=True

End Sub

Sub Order()

    On Error Resume Next
    Application.OnTime EarliestTime:=dTimeT1, Procedure:="Save_order", Schedule:=False
    On Error GoTo 0
    dTimeT1 = TimeValue("02:00:00")
    Application.OnTime EarliestTime:=dTimeT1, Procedure:="Save_order", Schedule:=True

    On Error Resume Next
    Application.OnTime EarliestTime:=dTimeT2, Procedure:="Save_order", Schedule:=False
    On Error GoTo 0
    dTimeT2 = TimeValue("10:00:00")
    Application.OnTime EarliestTime:=dTimeT2, Procedure:="Save_order", Schedule:=True

    On Error Resume Next
    Application.OnTime EarliestTime:=dTimeT3, Procedure:="Save_order", Schedule:=False
    On Error GoTo 0
    dTimeT3 = TimeValue("18:00:00")
    Application.OnTime EarliestTime:=dTimeT3, Procedure:="Save_order", Schedule:=True

End Sub

我按照你的建议做了，但仍然不行（代码已更新）。此外，当 Order 宏运行时，假设在 10:00，它运行 3 次。你能帮我多做一点吗？

标签： excelvbaschedule

解决方案

您使用 application.ontime 做的大部分事情都是正确的。但是您应该添加一件事。在设置新的 ontime 之前删除以前的。
举个例子：

dTimeT1 = now() + TimeValue("00:10:00")
Application.OnTime dTimeT1, "Save_order"

我也会改变它：

on error resume next ' in case dTimeT1 is not set
Application.OnTime EarliestTime:=dTimeT1, Procedure:="Save_order", Schedule:=False
on error goto 0
dTimeT1 = now() + TimeValue("00:10:00")
Application.OnTime EarliestTime:=dTimeT1, Procedure:="Save_order", Schedule:=True

因为如果 dTimeT1 是未来的某个时间，您最终可能会设置两个 application.ontimes 但您不能删除前一个，因为您的变量已更改。
所以总是清除前一个然后设置一个新的。当您手动运行宏时会出现此问题。

具体到您的问题：
我不确定您的停止功能。为什么你先设定一个时间表，然后再删除它？

为什么不只是？

Sub Stop_()
    on error resume next
    Application.OnTime EarliestTime:=dTimeB, Procedure:="Refresh_time", Schedule:=False
    Application.OnTime EarliestTime:=dTimeS, Procedure:="Save_it", Schedule:=False
    Application.OnTime EarliestTime:=dTimeT1, Procedure:="Save_order", Schedule:=False
    Application.OnTime EarliestTime:=dTimeT2, Procedure:="Save_order", Schedule:=False
    Application.OnTime EarliestTime:=dTimeT3, Procedure:="Save_order", Schedule:=False
    on error goto 0 
End Sub

例如，这是一个问题：

' set this to some time in future
dTimeT1 = TimeValue("12:00:00") 
Application.OnTime EarliestTime:=dTimeT1, Procedure:="Save_order", Schedule:=True

' we now set a new time
dTimeT1 = TimeValue("12:05:00")
Application.OnTime EarliestTime:=dTimeT1, Procedure:="Save_order", Schedule:=True

' we simulate a close of the workbook which should remove the schedule
Application.OnTime EarliestTime:=dTimeT1, Procedure:="Save_order", Schedule:=false

但是这段代码无论如何都会在 12:00 运行，因为您设置了两个计划但只删除了一个。

推荐阅读