Help with a closing WB w/o activity!
Chris,
The problem with using a message box is that, unlike a userform, no VBA
macro can execute while it is open. Someone must manually close it. So, this
defeats the whole point of the auto-close, which is designed to close the wb
if it is unattended. You can't use, for example, Application.Sendkeys to
programmatically close the message box after a number of seconds if there is
no response. And there is no code to my knowledge that can get around this
except perhaps for API code that I am not familiar with. (This is all just my
opinion and I admit I may be missing something).
Instead, I suggest the appended code which creates a toolbar on wb_open and
which supports the following buttons:
1. "Continue Working"
2. "Close Now"
3. "Disable"
If there is no response after the toolbar is displayed then the wb will
close in 10 seconds.
Also, note that I dispenced with the VBA event code used to monitor activity
and instead rely on monitoring the exact position of the mouse pointer. If
its x- and y-coordinates change between checks then it will suppress display
of the toolbar and will just reset the time of the next check (i.e. execute
the SetTime macro).
This is not a polished product, just something I came up with in response to
your post. It will likely have some flaws. The 1440 figure is the number of
minutes in a day. So 10 (the set wait time in minutes) divided by this figure
gives the correct fraction of a day. Change the value of the public constant
WaitTime to suit.
'xxxxxxxx Paste to the ThisWorkbook module xxxxxxxx
Private Sub Workbook_Open()
Dim msg As String
msg = "This workbook will auto-close after " & WaitSecs & _
" seconds of inactivity. "
MsgBox msg, vbInformation, "Auto-Close"
Call MakeToolBar
Call SetTime
End Sub
'xxxxxxxx Paste to a standard module xxxxxxxx
Option Explicit
Public Const WaitTime As Single = 10
Public KillTime As Date
Private Type POINTAPI
X As Long
Y As Long
End Type
Dim CursPos As POINTAPI
Private Declare Function GetCursorPos _
Lib "user32" (lpPoint As POINTAPI) As Long
Sub SetTime()
KillTime = Now + WaitTime / 1440
Application.OnTime KillTime, "TestForShutDown"
GetCursorPos CursPos
End Sub
Sub TestForShutDown()
Dim CP As POINTAPI
GetCursorPos CP
If CursPos.X = CP.X And CursPos.Y = CP.Y Then
With Application
.CommandBars("AutoClose").Visible = True
KillTime = Now + 10 / 1440
.OnTime KillTime, "Kill"
End With
Else
Call SetTime
End If
End Sub
Sub ContinueWorking()
With Application
.CommandBars("AutoClose").Visible = False
.OnTime KillTime, "Kill", Schedule:=False
End With
Call SetTime
End Sub
Sub Kill()
With Application
.CommandBars("AutoClose").Delete
If Now < KillTime Then .OnTime KillTime, "Kill", Schedule:=False
End With
ThisWorkbook.Close True
End Sub
Sub Disable()
With Application
.CommandBars("AutoClose").Visible = False
If Now < KillTime Then .OnTime KillTime, "Kill", Schedule:=False
End With
End Sub
Sub MakeToolBar()
Dim CB As CommandBar
Dim Btn As CommandBarButton
Dim i As Integer
Dim arr As Variant, arr2 As Variant
With Application
.ScreenUpdating = False
On Error Resume Next
.CommandBars("AutoClose").Delete
On Error GoTo 0
Set CB = .CommandBars.Add("AutoClose", Temporary:=True)
End With
arr = Array("Continue Working", "Close Now", "Disable")
arr2 = Array("ContinueWorking", "Kill", "Disable")
For i = 0 To 2
Set Btn = CB.Controls.Add
With Btn
.Caption = arr(i)
.OnAction = arr2(i)
.Style = msoButtonCaption
.BeginGroup = (i 0)
End With
Next
Application.ScreenUpdating = True
CB.Visible = False
End Sub
Best regards,
Greg
|