Note: The other languages of the website are Google-translated. Back to English
登录 注册

闲置一定时间后如何保存和关闭工作簿？

有时，当您长时间忙于其他事务时，可能会意外关闭工作簿，这可能会丢失工作簿中的一些重要数据。 如果您在一定时间内将其停用，是否有任何技巧可以自动保存和关闭工作簿？

VBA在一段时间不活动后自动保存并关闭工作簿

箭头蓝色右气泡 VBA在一段时间不活动后自动保存并关闭工作簿

Excel中没有内置函数可以解决此问题，但是我可以介绍一个宏代码，该代码可以帮助您在一段时间内不活动后保存和关闭工作簿。

1.启用要自动保存并在闲置几秒钟后关闭的工作簿，然后按 Alt + F11键 打开钥匙 Microsoft Visual Basic应用程序 窗口。

2。 点击 插页 > 模块 创造一个 模块 脚本，然后将以下代码粘贴到该脚本。 看截图：

Dim CloseTime As Date
Sub TimeSetting()
    CloseTime = Now + TimeValue("00:00:15")
    On Error Resume Next
    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

 

doc不活动后保存关闭工作簿1

3.然后在 项目浏览器 窗格，双击 本工作簿，然后将以下代码粘贴到next脚本中。 看截图：

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Call TimeStop
End Sub

Private Sub Workbook_Open()
    Call TimeSetting
End Sub

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

 

doc不活动后保存关闭工作簿2

4.双击在步骤2中插入的模块，然后按 F5 键来运行代码。 看截图：
doc不活动后保存关闭工作簿3

5.然后在15秒钟后弹出一个对话框，提醒您保存工作簿，然后单击 有 保存并关闭工作簿。
doc不活动后保存关闭工作簿4

提示：

（1）在第一个代码中，您可以在此字符串中将不活动时间更改为其他时间： 现在+ TimeValue（“ 00:00:15”）

（2）如果您以前从未保存过工作簿，则 另存为 对话框将首先出现，并要求您保存它。
doc不活动后保存关闭工作簿5

非常好 保护工作表
Kutools for Excel的 保护工作表 该功能可以一次快速保护多张纸或整个工作簿。
前往下载
60天免费试用购买
贝宝/ MyCommerce
doc保护多个工作表

最佳办公效率工具

Kutools for Excel解决了您的大多数问题，并使您的生产率提高了80％

  • 重用: 快速插入 复杂的公式，图表 以及您以前使用过的任何东西； 加密单元 带密码 创建邮件列表 并发送电子邮件...
  • 超级公式栏 （轻松编辑多行文本和公式）； 阅读版式 （轻松读取和编辑大量单元格）； 粘贴到过滤范围...
  • 合并单元格/行/列 不会丢失数据； 拆分单元格内容； 合并重复的行/列...防止细胞重复； 比较范围...
  • 选择重复或唯一 行; 选择空白行 （所有单元格都是空的）； 超级查找和模糊查找 在许多工作簿中； 随机选择...
  • 确切的副本 多个单元格，无需更改公式参考； 自动创建参考 到多张纸； 插入项目符号，复选框等...
  • 提取文字，添加文本，按位置删除， 删除空间; 创建和打印分页小计； 在单元格内容和注释之间转换...
  • 超级滤镜 （将过滤方案保存并应用于其他工作表）； 高级排序 按月/周/日，频率及更多； 特殊过滤器 用粗体，斜体...
  • 结合工作簿和工作表; 根据关键列合并表； 将数据分割成多个工作表; 批量转换xls，xlsx和PDF...
  • 超过300种强大功能. 支持 Office / Excel 2007-2021 和 365。支持所有语言。 在您的企业或组织中轻松部署。 完整功能 30 天免费试用。 60 天退款保证。
kte选项卡201905

Office选项卡为Office带来了选项卡式界面，使您的工作更加轻松

  • 在Word，Excel，PowerPoint中启用选项卡式编辑和阅读，发布者，Access，Visio和Project。
  • 在同一窗口的新选项卡中而不是在新窗口中打开并创建多个文档。
  • 每天将您的工作效率提高50％，并减少数百次鼠标单击！
officetab底部
按评论排序
最旧的
最新的
注释 (11)
还没有评分。 成为第一位评论！
Excel
Excel
该评论由网站上的主持人最小化
当单元格处于活动状态时，上述代码不起作用。 那是

1. 在单元格中输入一个值（不要按 Enter 或 Tab）

2.最小化excel。

在这种情况下，代码不起作用。
回复
0
0
通润
通润
该评论由网站上的主持人最小化
如果您在达到关闭时间时在单独的工作簿中工作，那么它将关闭该工作簿而不是非活动的工作簿。 这可以通过将代码调整为：

将 CloseTime 暗淡为​​日期
将 WKB 变暗为字符串
子时间设置（）
WKB = ActiveWorkbook.名称
CloseTime = 现在 + TimeValue("00:00:15")
出错时继续下一步
Application.OnTime EarliestTime:=CloseTime, _
程序：=“SavedAndClose”，计划：=True
END SUB
子 TimeStop()
出错时继续下一步
Application.OnTime EarliestTime:=CloseTime, _
程序：=“SavedAndClose”，计划：=假
END SUB
子 SavedAndClose()
工作簿（WKB）。关闭 Savechanges:=True
END SUB
回复
0
0
Ro
Ro     通润
该评论由网站上的主持人最小化
我注意到了同样的事情。 并找到了相同的解决方案:-)
回复
0
0
脉动
脉动     通润
该评论由网站上的主持人最小化
打开内置此代码的工作簿时，我有时会遇到“运行时错误”。 无论如何要更好地编写此代码以使其更稳定？
回复
0
0
SEB
SEB
该评论由网站上的主持人最小化
辉煌的感谢
回复
0
0
拉杰什拉纳
拉杰什拉纳
该评论由网站上的主持人最小化
嗨，我想将此代码插入到其他代码中，例如带有此代码的到期代码，我该怎么办......？
代码是...以下
私有子 Workbook_Open()

将 exdate 暗淡为​​日期
昏暗的整数

'在这里修改过期日期的值！！！
anul = 2019 '年
luna = 5'月
ziua = 16 '天

exdate = DateSerial(anul, luna, ziua)

If Date > exdate Then
MsgBox ("应用程序 " & ThisWorkbook.Name & " 已过期！" & vbNewLine & vbNewLine _
& "到期设置日期为：" & exdate & " :)" & vbNewLine & vbNewLine _
& "联系管理员更新版本！"), vbCritical, ThisWorkbook.Name

expired_file = ThisWorkbook.Path & "\" & ThisWorkbook.Name

出错时转到 ErrorHandler
使用工作簿（ThisWorkbook.Name）
如果 .Path <> "" 那么

.已保存 = 真
.ChangeFileAccess xlReadOnly

杀死过期文件

'如果是addin和unistall addin，则获取插件的名称
如果 Application.Version >= 12 那么
I = 5
否则：i = 4
结束如果

如果 Right(ThisWorkbook.Name, i) = ".xlam" 或 Right(ThisWorkbook.Name, i) = ".xla" 那么
wbName = Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - i)
'如果已安装插件，请卸载
如果 AddIns(wbName).Installed 那么
AddIns(wbName).Installed = False
结束如果
结束如果

。关

结束如果
结束

退出小组

结束如果

'MsgBox ("你有 " & exdate - 日期 & "剩余天数")
退出小组

错误处理程序：
MsgBox "删除文件失败.. "
退出小组

END SUB
回复
0
0
乔
乔
该评论由网站上的主持人最小化
如果您在达到关闭时间时在单独的工作簿中工作，那么它将关闭该工作簿而不是非活动的工作簿。 这可以通过调整代码来解决： - 从下面的评论中更正和测试 - 使用此代码：

进入“本工作簿”

Private Sub Workbook_BeforeClose（取消为布尔值）
呼叫 TimeStop
END SUB
私有子 Workbook_Open()
通话时间设置
END SUB
私有子工作簿_SheetChange（ByVal Sh 作为对象，ByVal 目标作为范围）
呼叫 TimeStop
通话时间设置
END SUB


进入“模块”：

将 CloseTime 暗淡为​​日期
子时间设置（）
CloseTime = 现在 + TimeValue("00:10:00")
出错时继续下一步
Application.OnTime EarliestTime:=CloseTime, _
程序：=“SavedAndClose”，计划：=True
END SUB
子 TimeStop()
出错时继续下一步
Application.OnTime EarliestTime:=CloseTime, _
程序：=“SavedAndClose”，计划：=假
END SUB
子 SavedAndClose()
ThisWorkbook.Close 保存更改：=True
END SUB


您可以通过更改 CloseTime = Now + TimeValue("00:10:00") 来更改时间设置 - 这设置为 10 分钟，将 ("00:10:00") 更改为您想要的任何时间并且它可以工作。
回复
0
0
的xman
的xman
该评论由网站上的主持人最小化
我不确定发生了什么，但这个解决方案不再有效。 这是对我有用的此解决方案的修复：

````
暗淡 resetCount As Long

公共子工作簿_Open()
出错时继续下一步
设置 xWB = ThisWorkbook
重置计数 = 0
END SUB

Private Sub Workbook_SheetChange（ByVal Sh As Object，ByVal Target As Range）错误继续下一步
重设
END SUB

Sub Reset()On Error Resume Next
静态 xCloseTime
如果 resetCount <> 0 则
ThisWorkbook.Application.OnTime xCloseTime, "SaveWork1", Schedule:=False
重置计数 = 重置计数 + 1
xCloseTime = DateAdd("n", 15, 现在)
ThisWorkbook.Application.OnTime xCloseTime, "SaveWork1", Schedule:=True

其他
重置计数 = 重置计数 + 1
xCloseTime = DateAdd("n", 15, 现在)
ThisWorkbook.Application.OnTime xCloseTime, "SaveWork1", Schedule:=True
结束如果
END SUB
````
这是使用相同的 SaveWork1 As：
````子SaveWork1（）
Application.DisplayAlerts = False
ThisWorkbook.保存
ThisWorkbook.关闭

Application.DisplayAlerts = True
END SUB

````
回复
0
0
杰森
杰森
该评论由网站上的主持人最小化
这很棒。 有关添加弹出消息框的任何提示，该消息框将警告用户工作表即将关闭并为他们提供重置计时器的选项？
回复
0
0
佩德罗·马托斯（Pedro Matos）
佩德罗·马托斯（Pedro Matos）
该评论由网站上的主持人最小化
当我不想编辑而只想咨询时，文件仍然关闭。 它不应该关闭。 当我选择单元格时应该重新开始计数。 解决办法是什么？
回复
0
0
佩德罗马托斯
佩德罗马托斯
该评论由网站上的主持人最小化
当我不想编辑而只想咨询时，文件仍然关闭。 它不应该关闭。 当我选择单元格时应该重新开始计数。 解决办法是什么？
回复
报告
0
0
这里还没有评论

关注我们

版权所有 © 2009 - extendoffice.com。 | 版权所有。 供电 ExtendOffice。 | 网站地图
Microsoft和Office徽标是Microsoft Corporation在美国和/或其他国家的商标或注册商标。
受Sectigo SSL保护