After long hours of search and scratching my brain, I have finally achieved my objective and this works smoothly. I have been testing this for 2 days simulating different situation and all have worked.
Hope this will help other to do similar tasks.
Cheers!
HTML Code:
Private Sub Workbook_Open()
' Trigger the timer when the workbook opens
' Sets the timer to 15 minutes
' where "00" Hours ":" "15" minutes ":" "00" Seconds
EndTime = Now + TimeValue("00:15:00")
RunTime
End Sub
HTML Code:
' Place the following two Worksheet Events in the Worksheet object
Private Sub Worksheet_Change(ByVal Target As Range)
If EndTime Then
Application.OnTime _
EarliestTime:=EndTime, _
Procedure:="CloseWB", _
Schedule:=False
EndTime = Empty
End If
EndTime = Now + TimeValue("00:15:00")
RunTime
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If EndTime Then
Application.OnTime _
EarliestTime:=EndTime, _
Procedure:="CloseWB", _
Schedule:=False
EndTime = Empty
End If
EndTime = Now + TimeValue("00:15:00")
RunTime
End Sub
HTML Code:
Option Explicit
'---------------------------------------------------------------------------------------
' DateTime : 09/05/2013 09:00 AM
' Author : RoyUk
' Amended by: Chuck Hamdan to suit the objective
' Purpose : Will auto close workbook when no activity. This will allow other to work
' with the workbook when required.
'---------------------------------------------------------------------------------------
Public EndTime
Sub RunTime()
Application.OnTime _
EarliestTime:=EndTime, _
Procedure:="CloseWB", _
Schedule:=True
End Sub
Sub CloseWB()
Dim fName As Variant
fName = ActiveWorkbook.Name
If OtherWBOpened Then
' If multiple workbook opened
' close only this workbook
With ThisWorkbook
.Application.DisplayAlerts = False
.SaveAs fName
.Application.DisplayAlerts = True
.Close
End With
Exit Sub
Else
' Else then close this workbook and close Excel
With ThisWorkbook
.Application.DisplayAlerts = False
.SaveAs fName
.Application.DisplayAlerts = True
.Close
.Application.Quit
End With
End If
End Sub
Public Function OtherWBOpened() As Boolean
'This Function will check whether other Workbooks
' are opened as well
Dim wbk As Workbook
Dim i As Integer
For Each wbk In Workbooks
i = i + 1
Next
If i > 1 Then
' more than one workbook opened
' set it to True
OtherWBOpened = True
Else
' else set it to False
OtherWBOpened = False
End If
End Function
Chuck
Bookmarks