如何在设定的时间后自动保存并退出工作表？ （Excel VBA）

Is there a way to make an open worksheet close itself if there is no activity on it for more than 5 minutes?

如果超过5分钟没有活动,有没有办法让一个开放的工作表关闭?

So for example: I work on a worksheet for a while then walk away for 20 minutes with said sheet open. Someone on the network requires to access the sheet but can't because I'm on it.

例如:我在工作表上工作了一段时间,然后在打开表单的情况下离开20分钟。网络上有人需要访问表单,但不能,因为我在上面。

I want it so that after me being away from my desk for more than 5 minutes the sheet will save itself and close out said sheet.

我想要它,以便在我离开办公桌超过5分钟后,纸张将自行保存并关闭所述纸张。

Is this possible? If so how? I can find scripts to show how to save and close a sheet, but I've yet to find one that uses a timer...

这可能吗?如果是这样的话?我可以找到脚本来显示如何保存和关闭工作表,但我还没找到一个使用计时器的脚本...

2 个解决方案

#1

This is the information from the link so this question can be used as a reference:

这是链接中的信息,因此这个问题可以作为参考:

Insert this code as module:

将此代码作为模块插入:

' DateTime  : 09/05/2007 08:43
' Author    : Roy Cox (royUK)
' Website   :  Clck here for more examples and Excel Consulting
' Purpose   : Place in a standard module
' Disclaimer; This code is offered as is with no guarantees. You may use it in your
'             projects but please leave this header intact.

'---------------------------------------------------------------------------------------
Option Explicit
Public EndTime
Sub RunTime()
    Application.OnTime _
            EarliestTime:=EndTime, _
            Procedure:="CloseWB", _
            Schedule:=True
End Sub
Sub CloseWB()
    Application.DisplayAlerts = False
    With ThisWorkbook
        .Save
        .Saved = True
        .Close
    End With
End Sub

Insert this in 'ThisWorkbook'

在“ThisWorkbook”中插入

Private Sub Workbook_Open()
    '--> Set Time Below
    EndTime = Now + TimeValue("00:00:00")
    RunTime
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If EndTime Then
        Application.OnTime _
        EarliestTime:=EndTime, _
        Procedure:="CloseWB", _
        Schedule:=False
        EndTime = Empty
    End If
    '--> Set Time Below
    EndTime = Now + TimeValue("00:00:00")
    RunTime
End Sub

#2

Ok, with the original answer below, I came up with my own, after a little more research.

好的,在下面的原始答案中,经过一番研究后,我想出了自己的答案。

Once you open the developer's section you will find your sheets, place this code below into ThisWorkbook. That will allow your code to work through the entire sheet. I now it set up where there is a 10:00 minute initial timer, and a 05:00 minute timer if there is activity after the fact. You can change that to whatever you want.

打开开发人员部分后,您将找到工作表,将此代码放在ThisWorkbook中。这将允许您的代码在整个工作表中工作。我现在设置了10:00分钟的初始计时器和05:00分钟的计时器,如果事后有活动的话。您可以将其更改为您想要的任何内容。

Option Explicit
Private Sub Workbook_Open()
    EndTime = Now + TimeValue("00:10:00")
    RunTime
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    If EndTime Then
        Application.OnTime _
                EarliestTime:=EndTime, _
                Procedure:="CloseWB", _
                Schedule:=False
        EndTime = Empty
    End If
    EndTime = Now + TimeValue("00:05:00")
    RunTime
End Sub

The part below this needs to go into a newly created module, name it whatever you want, mine is called SaveWB

下面的部分需要进入一个新创建的模块,无论你想要什么名称,我的名字都叫做SaveWB

Option Explicit

Public EndTime
Sub RunTime()
    Application.OnTime _
            EarliestTime:=EndTime, _
            Procedure:="CloseWB", _
            Schedule:=True
End Sub

Sub CloseWB()
    Application.DisplayAlerts = False
    With ThisWorkbook
        ThisWorkbook.Close savechanges:=True
    End With
End Sub

I changed the code from:

我更改了代码:

With ThisWorkbook
    .Save
    .Saved = True
    .Close
End With

To what was above it.

对于它上面的东西。

    With ThisWorkbook
        ThisWorkbook.Close savechanges:=True
    End With

The part I created works, the part that was originally posted works in closing but not saving. Do what you will with it, change it as you deem fit, but I am glad I got it working.

我创建的部分工作,最初发布的部分在关闭但不保存时起作用。做你想做的事情,按照你认为合适的方式改变它,但我很高兴我得到了它。