Excel vba 时间后关闭

Excel vba close after time

有谁知道 VBA 代码可以在延迟后关闭并保存 excel 文件?我尝试了一些 kutools 代码,这些代码本应仅在空闲时间后关闭,但它会在不检查是否处于活动状态的情况下关闭。

在例程模块中粘贴:

Option Explicit

Const idleTime = 30 'seconds
Dim Start
Sub StartTimer()
Start = Timer
Do While Timer < Start + idleTime
    DoEvents
Loop
'///////////////////////////////////////////////////////
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'Step 1: Declare your variables
Dim ws As Worksheet
'Step 2: Unhide the Starting Sheet
Sheets("Sheet1").Visible = xlSheetVisible
'Step 3: Start looping through all worksheets
For Each ws In ThisWorkbook.Worksheets
'Step 4: Check each worksheet name
If ws.Name <> "Sheet1" Then
'Step 5: Hide the sheet
ws.Visible = xlVeryHidden
End If
'Step 6: Loop to next worksheet
Next ws
'Application.ScreenUpdating = True

Range("A1").Select

ThisWorkbook.Save

'Application.DisplayAlerts = True
'//////////////////////////////////////////////////////////
'Application.DisplayAlerts = False
Application.Quit
ActiveWorkbook.Close SaveChanges:=True

Application.DisplayAlerts = True
End Sub

粘贴到本工作簿中:

Option Explicit

Private Sub Workbook_Open()
    StartTimer
End Sub

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

在例程模块中粘贴:

    Sub Reset()
Static SchedSave
    If SchedSave <> 0 Then
    Application.OnTime SchedSave, "SaveWork", , False
    End If
    SchedSave = Now + TimeValue("00:10:00")     '<--- Ten minutes
    Application.OnTime SchedSave, "SaveWork", , True
End Sub

Sub SaveWork()
MsgBox "Run the close workbook macro here."
'ThisWorkbook.Save
'Application.Quit
'ThisWorkbook.Close
End Sub

粘贴到本工作簿中:

Private Sub Workbook_Open()
Reset
End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Reset
End Sub

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

打开工作簿时,计时器会自动启动。当前设置为 10 分钟(可调整)。关闭宏代码已被禁用,目前已替换为 MsgBox 通知。