如何在设定的时间后自动保存并退出工作表?(Excel VBA)

声明:本页面是StackOverFlow热门问题的中英对照翻译,遵循CC BY-SA 4.0协议,如果您需要使用它,必须同样遵循CC BY-SA许可,注明原文地址和作者信息,同时你必须将它归于原作者(不是我):StackOverFlow 原文地址: http://stackoverflow.com/questions/10949361/
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

提示:将鼠标放在中文语句上可以显示对应的英文。显示中英文
时间:2020-09-11 16:26:09  来源:igfitidea点击:

How to automatically Save and Exit out of a worksheet after a set amount of time? (Excel VBA)

excel-vbavbaexcel

提问by Matt Ridge

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...

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

回答by Alistair Weir

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'

将此插入到“本工作簿”中

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

回答by Matt Ridge

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.

我创建的部分有效,最初发布的部分在关闭但未保存时有效。随心所欲,随心所欲地改变它,但我很高兴我让它起作用了。