View Single Post
  #10   Report Post  
Posted to microsoft.public.excel.programming
Greg Wilson Greg Wilson is offline
external usenet poster
 
Posts: 747
Default Help with a closing WB w/o activity!

I still got the occasional error so I revamped it a bit. I also IMO improved
the toolbar by forcing it to appear at the top-left corner area of the screen
and don't allow resize. This has been a work in progress and hopefully this
is the final version. Hav'nt found any problem with the revamp.

When in actual use you would change the WaitTime variable to something like
10 (minutes) instead of 0.1. It may be proven advisable to also use the
Workbook_SheetChange event to fire the SetTime macro.

Ignore all previous versions and go with this:

'xxxxx Paste to ThisWorkbook module xxxxx
Private Sub Workbook_Open()
Dim msg As String
msg = "This workbook will auto-close after " & WaitTime & _
" minutes of inactivity. "
MsgBox msg, vbInformation, "Auto-Close"
Call MakeToolBar
Call SetTime
End Sub

'xxxxx Paste to a standard module xxxxx
Option Explicit
Public Const WaitTime As Single = 0.1
Dim KillTime As Date
Dim TestTime As Date
Dim KillWithBtn As Boolean
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()
TestTime = Now + WaitTime / 1440
Application.OnTime TestTime, "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 + 0.1 / 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
If Not .CommandBars.ActionControl Is Nothing Then
.OnTime KillTime, "Kill", Schedule:=False
End If
.CommandBars("AutoClose").Delete
End With
ThisWorkbook.Close True
End Sub
Sub Disable()
With Application
.CommandBars("AutoClose").Visible = False
If Now < KillTime Then .OnTime KillTime, "Kill", Schedule:=False
If Now < TestTime Then .OnTime TestTime, "TestForShutDown",
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
CB.Protection = msoBarNoResize
CB.Top = 200
CB.Left = 200
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

Regards,
Greg