很久以前我掀起(或发现)一些代码,如果用户将其打开(例如隔夜或全天),会在一段时间后自动关闭共享工作簿。代码运行良好,除非它关闭它内部的工作簿;它还关闭所有工作簿并且也很出色(没有Application.Quit)。用户对此感到厌烦,是否有人知道如何才能让它只关闭(Thisworkbook),而不是所有其他人?
感谢。
以下代码:
Option Explicit
' Declarations
Private Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
Private mlngTimerID As Long
' start the timer
Public Sub StartTimer(lngInterval As Long)
mlngTimerID = SetTimer(0, 0, lngInterval, AddressOf TimerCallBack)
End Sub
' when the timer goes off
Public Sub TimerCallBack(ByVal hwnd As Long, ByVal uMsg As Long, ByVal idEvent As Long, ByVal dwTime As Long)
' stop the timer
StopTimer
' don't save if read only
If ThisWorkbook.ReadOnly = False Then
' save
ThisWorkbook.Save
End If
' exit without saving
ThisWorkbook.Activate
ThisWorkbook.Close False
End Sub
Public Sub StopTimer()
KillTimer 0, mlngTimerID
End Sub
'To use timer:
'To start the timer
'Call startTimer(1000)'1000 = 1 Second
'To stop timer
'Call stopTimer
答案 0 :(得分:2)
我知道这是一个较老的问题,但我想我会分享一个适合我的决议。打开时,工作簿将存储为Public变量,以便在计时器到期时它将是唯一关闭的工作簿。如果在时间到期之前关闭工作簿,则取消计时器。如果计时器到期且工作簿仍处于打开状态,则会自动保存并关闭。
将下面的代码插入“ThisWorkbook”
'When the workbook is opened, call StartTimer()
Public Sub Workbook_Open()
Run "StartTimer"
End Sub
'Detect if the workbook is closed
Public Sub Workbook_BeforeClose(Cancel As Boolean)
'Cancel Saveclose
Run "StopTimer"
End Sub
将以下代码插入模块
'Global variables
Public RunWhen As Double
Public Const cRunIntervalSeconds = 300 ' seconds (set to 5 minutes)
Public Const cRunWhat = "SaveClose" ' the name of the procedure to run
Public GlobalBook As Workbook
'Start Timer using interval set in global variables
Sub StartTimer()
Set GlobalBook = ActiveWorkbook
RunWhen = Now + TimeSerial(0, 0, cRunIntervalSeconds)
Application.OnTime EarliestTime:=RunWhen, Procedure:=cRunWhat, _
Schedule:=True
End Sub
'Stop the Timer whenever the workbook is closed prematurely
Public Sub StopTimer()
On Error Resume Next
Application.OnTime EarliestTime:=RunWhen, Procedure:=cRunWhat, _
Schedule:=False
End Sub
'Close the workbook automatically once the Timer has expired
Public Sub SaveClose()
'Time is up, workbook will save and close automatically
Dim wb As Workbook
For Each wb In Workbooks
'Check to see if workbook is still open
If wb.Name = GlobalBook.Name Then
Set wb = Application.Workbooks(GlobalBook.Name)
'Close workbook and Save Changes
wb.Close SaveChanges:=True
End If
Next
End Sub
答案 1 :(得分:1)