+ Reply to Thread
Results 1 to 12 of 12

Excel Session timer 10min splash screen Warning then 15min force close

Hybrid View

  1. #1
    Forum Expert shg's Avatar
    Join Date
    06-20-2007
    Location
    The Great State of Texas
    MS-Off Ver
    2010, 2019
    Posts
    40,689

    Re: Splash screen after 10min of excel open error

    When you unschedule, you have to pass the time it was scheduled, just like for the other routine.
    Entia non sunt multiplicanda sine necessitate

  2. #2
    Registered User
    Join Date
    01-19-2009
    Location
    Montreal, Quebec
    MS-Off Ver
    Excel 2003
    Posts
    13

    Re: Splash screen after 10min of excel open error

    It works! So i added an extra part that closes the workbook after 15min, so the splash screen will serve as a warning that 10min are up and 5min remaining before a save close event is forced.

    This will prevent the users from "hogging" the file.

    here's the final working code

    In workbook:

    Private Sub Workbook_BeforeClose(Cancel As Boolean)
    StopTimer
    End Sub
    
    Private Sub Workbook_Open()
    
    StartTimer10min
    StartTimer15min
    
    End Sub
    In my module:

    
    Public RunWhen As Double
    Public RunWhen2 As Double
    Public Const cRunIntervalSeconds10 = 600 '10min
    Public Const cRunWhat10 = "MsgPrompt"  ' the name of the procedure to run
    Public Const cRunIntervalSeconds15 = 900 '15min
    Public Const cRunWhat15 = "CloseAll"  ' the name of the 2nd procedure to run
    
    'This program prompts the user after time has met a preset
    Sub MsgPrompt()
        UserForm2.Show
    End Sub
    
    Sub StartTimer10min()
        RunWhen = Now + TimeSerial(0, 0, cRunIntervalSeconds10)
        Application.OnTime EarliestTime:=RunWhen, Procedure:=cRunWhat10, _
            Schedule:=True
    End Sub
    Sub StartTimer15min()
        RunWhen2 = Now + TimeSerial(0, 0, cRunIntervalSeconds15)
        Application.OnTime EarliestTime:=RunWhen2, Procedure:=cRunWhat15, _
            Schedule:=True
    End Sub
    
    Sub KillForm()
    Unload UserForm2
    End Sub
    Sub StopTimer()
            On Error Resume Next
        Application.OnTime EarliestTime:=RunWhen, Procedure:=cRunWhat10, _
            Schedule:=False
            
            On Error Resume Next
        Application.OnTime EarliestTime:=RunWhen2, Procedure:=cRunWhat15, _
            Schedule:=False
            
            On Error Resume Next
    Application.OnTime EarliestTime:=Now + TimeValue("00:00:07"), Procedure:="KillForm", _
    Schedule:=False
    End Sub
    
    Sub CloseAll()
    
    'This closes the file, and saves any changes if changes were made 
    Workbooks("Book1.xls").Close SaveChanges:=True
    End Sub
    userform code:

    Public Sub UserForm_Initialize()
    Application.OnTime Now + TimeValue("00:00:07"), "KillForm"
    End Sub
    Thanks again
    Last edited by Phil_pac; 02-17-2009 at 09:42 AM.

+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1