Closing WB with a timer no changing sheets to very hidden

**Nitro2481** · 04-02-2016, 12:30 PM

Hi Guys,

I have this code in my "This workbook"

Option Explicit
Option Compare Text
Dim ws As Worksheet
Const MaxUses As Long = 5   '<- change uses
Const wsWarningSheet As String = "Splash"

Private Type mySheetVisibilityStructure
  sSheetName As String
  iVisibility As Long
End Type

Private bGblDoNotCancelIfCalledFromCloseEvent As Boolean

Const sSheetNameThatMUST_REMAIN_VISIBLE = "Splash"
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

  Dim wks As Worksheet
  Dim mySheetVisibilityStructureArray() As mySheetVisibilityStructure
  Dim i As Long
  Dim iVisibility As Long
  Dim iVisibilityErrorSheet As Long
  Dim sActiveSheetName As String
  Dim sErrorSheetName As String
  Dim sSheetName As String
  
  'Initialize the 'Sheet Visibiilty Structure Array'
  ReDim mySheetVisibilityStructureArray(1 To 1)
  
  'Save the 'Active Sheet' Name
  sActiveSheetName = ActiveSheet.Name
  
  'Verify that the 'Master Sheet' exists
  On Error Resume Next
  iVisibility = Sheets(sSheetNameThatMUST_REMAIN_VISIBLE).Visible
  If Err.Number <> 0 Then
    Err.Clear
    MsgBox "SAVE NOT DONE.  Data Integrity Error." & vbCrLf & _
           "In order to save this file Sheet '" & sSheetNameThatMUST_REMAIN_VISIBLE & "' MUST EXIST." & vbCrLf & vbCrLf & _
           "WARNING.  If this condition is NOT CORRECTED, Data may be LOST."
    Cancel = True   'Cancel Save
    On Error GoTo 0
    Exit Sub
  End If
  On Error GoTo 0
  
  'Disable 'Screen Updating' to eliminate Screen Flicker
  Application.ScreenUpdating = False
  
  'Save the 'Visibility of Each Sheet'
  'Make all Sheets Hidden Except the 'Master Sheet'
  For Each wks In ThisWorkbook.Sheets
      'Add an element to the 'Sheet Visibiilty Structure Array'
      'Put the 'Sheet Name' and the 'Sheet Visibility' in the Array
      i = i + 1
      ReDim Preserve mySheetVisibilityStructureArray(1 To i)
      mySheetVisibilityStructureArray(i).sSheetName = wks.Name
      mySheetVisibilityStructureArray(i).iVisibility = wks.Visible
      
    'Make the 'Master Sheet' visible and the Active Sheet
    'Hide All other Sheets
    If UCase(wks.Name) = UCase(sSheetNameThatMUST_REMAIN_VISIBLE) Then
      'Make the 'Master Sheet' visible and make the 'Master Sheet' the 'Active Sheet'
      wks.Visible = xlSheetVisible
      wks.Activate
    Else
      'Hide all other Sheets
      wks.Visible = xlSheetVeryHidden  'Can be 'xlSheetHidden' or 'xlSheetVeryHidden'
    End If
  
  Next wks
  
  'Turn Off Excel Events
  Application.EnableEvents = False
  

  'Save this file
  ThisWorkbook.Save
  
'Cancel command removed from here and moved to the bottom of the routine


  'Restore Original Sheet Visibility
  For i = LBound(mySheetVisibilityStructureArray) To UBound(mySheetVisibilityStructureArray)
    sSheetName = mySheetVisibilityStructureArray(i).sSheetName
    iVisibility = mySheetVisibilityStructureArray(i).iVisibility
    
    'A runtime error will occur if Excel attempt to hide all Sheets
    On Error Resume Next
    Sheets(sSheetName).Visible = iVisibility
    If Err.Number = 1004 Then
      Err.Clear
      sErrorSheetName = sSheetName
      iVisibilityErrorSheet = iVisibility
    End If
    On Error GoTo 0
  Next i
  
  'If a Sheet had a runtime error - restore it's original visibility
  If Len(sErrorSheetName) > 0 Then
    Sheets(sErrorSheetName).Visible = iVisibilityErrorSheet
  End If
  
  'Resume with the 'Original Active Sheet'
  Sheets(sActiveSheetName).Activate
  
  'Turn On Excel Events
  'Turn On Screen Updating
  Application.EnableEvents = True
  Application.ScreenUpdating = True


 'Reset Iterations in an attempt to prevent 'Circular Reference' Error
  Application.Iteration = True
  Application.MaxIterations = 1
  Application.MaxChange = 0.001

    ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
        False, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
        AllowFormattingRows:=True, AllowSorting:=True, AllowFiltering:=True, _
        AllowUsingPivotTables:=True
    ActiveSheet.EnableSelection = xlUnlockedCells
    
  
  'Cancel Save - to prevent recursion
  If bGblDoNotCancelIfCalledFromCloseEvent = True Then
    'Do nothing - Prevent Cancel
  ElseIf SaveAsUI = True Then
    'Do nothing - Prevent Cancel - Allow Save As Dialog Box
  Else
    Cancel = True
  End If
  
  'Reset the Global Called From Save Event Flag
  bGblDoNotCancelIfCalledFromCloseEvent = False
End Sub
Public Sub MakeAllSheetsVisible()
  Dim wks As Worksheet
  For Each wks In ThisWorkbook.Sheets
    wks.Visible = xlSheetVisible
  Next wks
End Sub

Private Sub Workbook_Open()
  For Each ws In ThisWorkbook.Sheets
        If ws.Name = wsWarningSheet Then
            ws.Visible = True
        Else
            ws.Visible = xlVeryHidden
        End If
    Next
    
    'record opening in remote cell
    With Sheets(wsWarningSheet).Cells(Rows.Count, Columns.Count)
      
    End With

Const sHide2 As String = "AA:AA, Ak:Ak, Ap:Ap, AQ:AQ, Av:Av, Aw:Aw, Bb:Bb, Bc:Bc, Bh:Bh, Bi:Bi, Bn:Bn, Bo:Bo, Bt:Bt, Bu:Bu, Bz:Bz, ca:ca "
Const sHide4 As String = "I:I, O:O"
Const sHide5 As String = "i:i, n:n"

With Sheet2
    Application.EnableEvents = False
    .Cells(1, 36).ClearContents
    Application.EnableEvents = True
    .Unprotect
    '.Range(sHide2 & 1).EntireColumn.Hidden = True
    .Range(sHide2).EntireColumn.Hidden = True
    .Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
        False, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
        AllowFormattingRows:=True, AllowSorting:=True, AllowFiltering:=True, _
        AllowUsingPivotTables:=True
    .EnableSelection = xlUnlockedCells
End With

With Sheet4
    Application.EnableEvents = False
    .Cells(2, 16).ClearContents
    Application.EnableEvents = True
    .Unprotect
    '.Range(sHide2 & 1).EntireColumn.Hidden = True
    .Range(sHide2).EntireColumn.Hidden = True
    .Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
        False, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
        AllowFormattingRows:=True, AllowSorting:=True, AllowFiltering:=True, _
        AllowUsingPivotTables:=True
    .EnableSelection = xlUnlockedCells
End With

With Sheet5
    Application.EnableEvents = False
    .Cells(1, 17).ClearContents
    Application.EnableEvents = True
    .Unprotect
    '.Range(sHide2 & 1).EntireColumn.Hidden = True
    .Range(sHide2).EntireColumn.Hidden = True
    .Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
        False, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
        AllowFormattingRows:=True, AllowSorting:=True, AllowFiltering:=True, _
        AllowUsingPivotTables:=True
    .EnableSelection = xlUnlockedCells
End With

     UserForm1.Show

  'Enable Timers on Workbook Open
  bGblInhibitTimers = False

  'Stop all timers
  On Error Resume Next
  Application.OnTime RunWhen, "SaveAndClose", , False
  Application.OnTime RunStatusBarWhen, "TimeTilExitTimer", , False
  On Error GoTo 0
 
  'Arm Timer to save and close workbook
  RunWhen = Now + TimeSerial(0, NUM_MINUTES, NUM_SECONDS)
  Application.OnTime RunWhen, "SaveAndClose", , True

  'Arm Timer to display time remaining
  RunStatusBarWhen = Now + TimeSerial(0, 0, STATUS_BAR_REFRESH_TIME_IN_SECONDS)
  Application.OnTime RunStatusBarWhen, "TimeTilExitTimer", , True

 Application.Iteration = True
  Application.MaxIterations = 1
  Application.MaxChange = 0.001
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    On Error Resume Next
    Application.OnTime RunWhen, "SaveAndClose", , False
    On Error GoTo 0
    
    'Display Time Remaining Only When timers are enabled
    If bGblInhibitTimers = False Then
      RunWhen = Now + TimeSerial(0, NUM_MINUTES, NUM_SECONDS)
      Application.OnTime RunWhen, "SaveAndClose", , True
    End If
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, _
    ByVal Target As Range)

    On Error Resume Next
    Application.OnTime RunWhen, "SaveAndClose", , False
    
    On Error GoTo 0
    'Display Time Remaining Only When timers are enabled
    If bGblInhibitTimers = False Then
      RunWhen = Now + TimeSerial(0, NUM_MINUTES, NUM_SECONDS)
      Application.OnTime RunWhen, "SaveAndClose", , True
    End If

End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)

' Hide all sheets except the splash sheet
SHideAllSheets

'Stop all timers
  On Error Resume Next
  Application.OnTime RunWhen, "SaveAndClose", , False
  Application.OnTime RunStatusBarWhen, "TimeTilExitTimer", , False
  On Error GoTo 0
  
  'Disable 'Save Cancel' if Called from Here
  bGblDoNotCancelIfCalledFromCloseEvent = True

  'Clear the Status Bar
  Application.StatusBar = ""
'Sheet16.Visible = True    ' redundant
'Sheet16.Select               ' redundant

End Sub


Sub SHideAllSheets()

Dim ws As Worksheet
' global constant
' Const wsWarningSheet As String = "Splash"

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False

For Each ws In ThisWorkbook.Sheets
    If ws.Name = wsWarningSheet Then
        ws.Visible = True
    Else
        ws.Visible = xlVeryHidden
    End If
Next

ThisWorkbook.Save

Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True

Sheet16.Visible = True
Sheet16.Select
End Sub

This changes all sheets from very hidden to visible and when closing back to very hidden again. This stops sheets from being visible if there is a macro error when the sheet is starting up. This works perfect.

I also have a timer set up that if there is no activity in 10 minutes the workbook auto closes. When this happens the sheets do not change to very hidden therefore and macro errors going forward display all sheets which I really do not want.

Option Explicit
'Module1
Public bGblInhibitTimers As Boolean
Public RunWhen As Double
Public RunStatusBarWhen As Double
Public Const NUM_MINUTES = 10
Public Const NUM_SECONDS = 0
Public Const STATUS_BAR_REFRESH_TIME_IN_SECONDS = 1

Public Sub StopTimers()
  'This is used for debugging purposes to shut down the timers

  bGblInhibitTimers = True
  On Error Resume Next
  Application.OnTime RunWhen, "SaveAndClose", , False
  Application.OnTime RunStatusBarWhen, "TimeTilExitTimer", , False
  On Error GoTo 0
 
  Application.StatusBar = "Timers stopped by StopTimers()."


End Sub

Public Sub SaveAndClose()

  'Tell the time remaining timer to stop
  bGblInhibitTimers = True
  
  On Error Resume Next
  Application.OnTime RunStatusBarWhen, "TimeTilExitTimer", , False
  On Error GoTo 0
  'Debug.Print "bGblInhibitTimers = true in SaveAndClose() at " & Now
  
  'Return control of the Status Bar to Excel
  Application.StatusBar = ""
  Application.StatusBar = False
   
  ThisWorkbook.Close savechanges:=True
End Sub

Sub TestTime()
  RunWhen = Now + TimeSerial(0, NUM_MINUTES, NUM_SECONDS)
  Debug.Print Format(RunWhen, "mm/dd/yy hh:mm:ss AM/PM")
End Sub
Sub TimeTilExitTimer()
  'This displays a time until exit message

  Const SECONDS_PER_DAY = 86400#
  Const SECONDS_PER_MINUTE = 60#
  
  Dim sMessage As String
  Dim ySecondsTimeToExit As Double
  Dim yMinutes As Double
  Dim ySeconds As Double

  Dim myTime As Date
  
  'Get the current date and time
  myTime = Now()
  
  'Calculate the number of seconds remaining to shut down
  ySecondsTimeToExit = SECONDS_PER_DAY * (RunWhen - myTime)
  
  'Check for Integrity Error - RunWhen = 0
  'Should Never Happen - Shut Down the refresh timer
  If ySecondsTimeToExit < 0 Then
    bGblInhibitTimers = True
    Application.StatusBar = "Software Integrity Error - Time Remaining Display discontinued."
  End If
  
  If ySecondsTimeToExit <= 99 Then
    sMessage = "Program will time out and exit in " & Format(ySecondsTimeToExit, "0") & " Seconds."
  Else
    yMinutes = Int(ySecondsTimeToExit / SECONDS_PER_MINUTE)
    ySeconds = Int(ySecondsTimeToExit - 60 * yMinutes)
    If yMinutes > 0 And ySeconds >= 60 Then
      yMinutes = yMinutes + 1
      ySeconds = ySeconds - 60
    End If
    
    sMessage = "Program will time out and exit at " & Format(RunWhen, "hh:mm:ss AM/PM") & " in " & _
                Format(yMinutes, "0") & " Minutes " & Format(ySeconds, "0") & " Seconds."
  End If
  
  
  If bGblInhibitTimers = True Then
    'Return control of the Status Bar to Excel
    Application.StatusBar = ""
    Application.StatusBar = False
    'Debug.Print "bGblInhibitTimers = true in TimeTilExitTimer() at " & Now

  Else
    Application.DisplayStatusBar = True
    Application.StatusBar = sMessage

    RunStatusBarWhen = Now + TimeSerial(0, 0, STATUS_BAR_REFRESH_TIME_IN_SECONDS)
    Application.OnTime RunStatusBarWhen, "TimeTilExitTimer", , True
    'Debug.Print "bGblInhibitTimers = false in TimeTilExitTimer() at " & Now
  End If

End Sub

I'm assuming I also need a "change all sheets to very hidden on close" code in the timer section but not sure how I would go about that.

I have manually set all sheets bar Splash to very hidden. If you close this with the x on top and try to open the spreadsheet with macros on high you get a warning with only the splash sheet visible. If the timer runs out (for this example I have set the timer at 1 min)and the sheet closes and you reopen with macros set to high you get the same warning message but all sheets are visible and accessible. Although I am aware that Excel is not secure I am more worried about someone stumbling across this information as opposed to being malicious. I have attached the spreadsheet. If you select user name: John and password: Test

Thank you

**Kevin#** · 04-02-2016, 12:57 PM

Insert this in the code before file saves and closes.
There must be at least one sheet visible - assumes that "Splash" is that sheet. All other sheets are hidden.

Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
    If ws.Name <> "Splash" Then ws.Visible = xlVeryHidden
Next ws

To unhide all sheets

For Each ws In ThisWorkbook.Worksheets
    ws.Visible = xlSheetVisible
Next ws

**shg** · 04-02-2016, 01:40 PM

Kevin, you need to set Splash visible before running that first loop, for the very reason you mentioned.

**Kevin#** · 04-02-2016, 03:08 PM

@shg is correct. I was assuming that it was visible from the write up.
To ensure that is the case, insert this line as the first line.

Sheets("Splash").Visible = xlSheetVisible

**Nitro2481** · 04-03-2016, 05:38 AM

Thanks for the reply guys,

I'm not great at code. I've been helped with everything I've done so far. Where do I put this extra code. I assumed it was in the timer module which I did below but this didn't rehide the sheets when the timer ran out.

Option Explicit
'Module1
Public bGblInhibitTimers As Boolean
Public RunWhen As Double
Public RunStatusBarWhen As Double
Public Const NUM_MINUTES = 1
Public Const NUM_SECONDS = 0
Public Const STATUS_BAR_REFRESH_TIME_IN_SECONDS = 1

Public Sub StopTimers()
  'This is used for debugging purposes to shut down the timers

  bGblInhibitTimers = True
  On Error Resume Next
  Application.OnTime RunWhen, "SaveAndClose", , False
  Application.OnTime RunStatusBarWhen, "TimeTilExitTimer", , False
  On Error GoTo 0
 
  Application.StatusBar = "Timers stopped by StopTimers()."


End Sub

Public Sub SaveAndClose()

  'Tell the time remaining timer to stop
  bGblInhibitTimers = True
  
  On Error Resume Next
  Application.OnTime RunStatusBarWhen, "TimeTilExitTimer", , False
  On Error GoTo 0
  'Debug.Print "bGblInhibitTimers = true in SaveAndClose() at " & Now
  
  'Return control of the Status Bar to Excel
  Application.StatusBar = ""
  Application.StatusBar = False
Dim ws As Worksheet
Sheets("Splash").Visible = xlSheetVisible
For Each ws In ThisWorkbook.Worksheets
    If ws.Name <> "Splash" Then ws.Visible = xlVeryHidden
Next ws
  For Each ws In ThisWorkbook.Worksheets
    ws.Visible = xlSheetVisible
Next ws
  ThisWorkbook.Close savechanges:=True
End Sub

Sub TestTime()
  RunWhen = Now + TimeSerial(0, NUM_MINUTES, NUM_SECONDS)
  Debug.Print Format(RunWhen, "mm/dd/yy hh:mm:ss AM/PM")
End Sub
Sub TimeTilExitTimer()
  'This displays a time until exit message

  Const SECONDS_PER_DAY = 86400#
  Const SECONDS_PER_MINUTE = 60#
  
  Dim sMessage As String
  Dim ySecondsTimeToExit As Double
  Dim yMinutes As Double
  Dim ySeconds As Double

  Dim myTime As Date
  
  'Get the current date and time
  myTime = Now()
  
  'Calculate the number of seconds remaining to shut down
  ySecondsTimeToExit = SECONDS_PER_DAY * (RunWhen - myTime)
  
  'Check for Integrity Error - RunWhen = 0
  'Should Never Happen - Shut Down the refresh timer
  If ySecondsTimeToExit < 0 Then
    bGblInhibitTimers = True
    Application.StatusBar = "Software Integrity Error - Time Remaining Display discontinued."
  End If
  
  If ySecondsTimeToExit <= 99 Then
    sMessage = "Program will time out and exit in " & Format(ySecondsTimeToExit, "0") & " Seconds."
  Else
    yMinutes = Int(ySecondsTimeToExit / SECONDS_PER_MINUTE)
    ySeconds = Int(ySecondsTimeToExit - 60 * yMinutes)
    If yMinutes > 0 And ySeconds >= 60 Then
      yMinutes = yMinutes + 1
      ySeconds = ySeconds - 60
    End If
    
    sMessage = "Program will time out and exit at " & Format(RunWhen, "hh:mm:ss AM/PM") & " in " & _
                Format(yMinutes, "0") & " Minutes " & Format(ySeconds, "0") & " Seconds."
  End If
  
  
  If bGblInhibitTimers = True Then
    'Return control of the Status Bar to Excel
    Application.StatusBar = ""
    Application.StatusBar = False
    'Debug.Print "bGblInhibitTimers = true in TimeTilExitTimer() at " & Now

  Else
    Application.DisplayStatusBar = True
    Application.StatusBar = sMessage

    RunStatusBarWhen = Now + TimeSerial(0, 0, STATUS_BAR_REFRESH_TIME_IN_SECONDS)
    Application.OnTime RunStatusBarWhen, "TimeTilExitTimer", , True
    'Debug.Print "bGblInhibitTimers = false in TimeTilExitTimer() at " & Now
  End If

End Sub

**Nitro2481** · 04-03-2016, 05:47 AM

I have also tried it in "This Workbook"section but again didn't work although I expect I've put it in wrong

Option Explicit
Option Compare Text
Dim ws As Worksheet
Const MaxUses As Long = 5   '<- change uses
Const wsWarningSheet As String = "Splash"

Private Type mySheetVisibilityStructure
  sSheetName As String
  iVisibility As Long
End Type

Private bGblDoNotCancelIfCalledFromCloseEvent As Boolean

Const sSheetNameThatMUST_REMAIN_VISIBLE = "Splash"
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

  Dim wks As Worksheet
  Dim mySheetVisibilityStructureArray() As mySheetVisibilityStructure
  Dim i As Long
  Dim iVisibility As Long
  Dim iVisibilityErrorSheet As Long
  Dim sActiveSheetName As String
  Dim sErrorSheetName As String
  Dim sSheetName As String
  
  'Initialize the 'Sheet Visibiilty Structure Array'
  ReDim mySheetVisibilityStructureArray(1 To 1)
  
  'Save the 'Active Sheet' Name
  sActiveSheetName = ActiveSheet.Name
  
  'Verify that the 'Master Sheet' exists
  On Error Resume Next
  iVisibility = Sheets(sSheetNameThatMUST_REMAIN_VISIBLE).Visible
  If Err.Number <> 0 Then
    Err.Clear
    MsgBox "SAVE NOT DONE.  Data Integrity Error." & vbCrLf & _
           "In order to save this file Sheet '" & sSheetNameThatMUST_REMAIN_VISIBLE & "' MUST EXIST." & vbCrLf & vbCrLf & _
           "WARNING.  If this condition is NOT CORRECTED, Data may be LOST."
    Cancel = True   'Cancel Save
    On Error GoTo 0
    Exit Sub
  End If
  On Error GoTo 0
  
  'Disable 'Screen Updating' to eliminate Screen Flicker
  Application.ScreenUpdating = False
  
  'Save the 'Visibility of Each Sheet'
  'Make all Sheets Hidden Except the 'Master Sheet'
  For Each wks In ThisWorkbook.Sheets
      'Add an element to the 'Sheet Visibiilty Structure Array'
      'Put the 'Sheet Name' and the 'Sheet Visibility' in the Array
      i = i + 1
      ReDim Preserve mySheetVisibilityStructureArray(1 To i)
      mySheetVisibilityStructureArray(i).sSheetName = wks.Name
      mySheetVisibilityStructureArray(i).iVisibility = wks.Visible
      
    'Make the 'Master Sheet' visible and the Active Sheet
    'Hide All other Sheets
    If UCase(wks.Name) = UCase(sSheetNameThatMUST_REMAIN_VISIBLE) Then
      'Make the 'Master Sheet' visible and make the 'Master Sheet' the 'Active Sheet'
      wks.Visible = xlSheetVisible
      wks.Activate
    Else
      'Hide all other Sheets
      wks.Visible = xlSheetVeryHidden  'Can be 'xlSheetHidden' or 'xlSheetVeryHidden'
    End If
  
  Next wks
  
  'Turn Off Excel Events
  Application.EnableEvents = False
  Dim ws As Worksheet
Sheets("Splash").Visible = xlSheetVisible
For Each ws In ThisWorkbook.Worksheets
    If ws.Name <> "Splash" Then ws.Visible = xlVeryHidden
Next ws
  For Each ws In ThisWorkbook.Worksheets
    ws.Visible = xlSheetVisible
Next ws

  'Save this file
  ThisWorkbook.Save
  
'Cancel command removed from here and moved to the bottom of the routine


  'Restore Original Sheet Visibility
  For i = LBound(mySheetVisibilityStructureArray) To UBound(mySheetVisibilityStructureArray)
    sSheetName = mySheetVisibilityStructureArray(i).sSheetName
    iVisibility = mySheetVisibilityStructureArray(i).iVisibility
    
    'A runtime error will occur if Excel attempt to hide all Sheets
    On Error Resume Next
    Sheets(sSheetName).Visible = iVisibility
    If Err.Number = 1004 Then
      Err.Clear
      sErrorSheetName = sSheetName
      iVisibilityErrorSheet = iVisibility
    End If
    On Error GoTo 0
  Next i
  
  'If a Sheet had a runtime error - restore it's original visibility
  If Len(sErrorSheetName) > 0 Then
    Sheets(sErrorSheetName).Visible = iVisibilityErrorSheet
  End If
  
  'Resume with the 'Original Active Sheet'
  Sheets(sActiveSheetName).Activate
  
  'Turn On Excel Events
  'Turn On Screen Updating
  Application.EnableEvents = True
  Application.ScreenUpdating = True


 'Reset Iterations in an attempt to prevent 'Circular Reference' Error
  Application.Iteration = True
  Application.MaxIterations = 1
  Application.MaxChange = 0.001

    ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
        False, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
        AllowFormattingRows:=True, AllowSorting:=True, AllowFiltering:=True, _
        AllowUsingPivotTables:=True
    ActiveSheet.EnableSelection = xlUnlockedCells
    
  
  'Cancel Save - to prevent recursion
  If bGblDoNotCancelIfCalledFromCloseEvent = True Then
    'Do nothing - Prevent Cancel
  ElseIf SaveAsUI = True Then
    'Do nothing - Prevent Cancel - Allow Save As Dialog Box
  Else
    Cancel = True
  End If
  
  'Reset the Global Called From Save Event Flag
  bGblDoNotCancelIfCalledFromCloseEvent = False
End Sub
Public Sub MakeAllSheetsVisible()
  Dim wks As Worksheet
  For Each wks In ThisWorkbook.Sheets
    wks.Visible = xlSheetVisible
  Next wks
End Sub

Private Sub Workbook_Open()
  For Each ws In ThisWorkbook.Sheets
        If ws.Name = wsWarningSheet Then
            ws.Visible = True
        Else
            ws.Visible = xlVeryHidden
        End If
    Next
    
    'record opening in remote cell
    With Sheets(wsWarningSheet).Cells(Rows.Count, Columns.Count)
      
    End With

Const sHide2 As String = "AA:AA, Ak:Ak, Ap:Ap, AQ:AQ, Av:Av, Aw:Aw, Bb:Bb, Bc:Bc, Bh:Bh, Bi:Bi, Bn:Bn, Bo:Bo, Bt:Bt, Bu:Bu, Bz:Bz, ca:ca "
Const sHide4 As String = "I:I, O:O"
Const sHide5 As String = "i:i, n:n"

With Sheet2
    Application.EnableEvents = False
    .Cells(1, 36).ClearContents
    Application.EnableEvents = True
    .Unprotect
    '.Range(sHide2 & 1).EntireColumn.Hidden = True
    .Range(sHide2).EntireColumn.Hidden = True
    .Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
        False, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
        AllowFormattingRows:=True, AllowSorting:=True, AllowFiltering:=True, _
        AllowUsingPivotTables:=True
    .EnableSelection = xlUnlockedCells
End With

With Sheet4
    Application.EnableEvents = False
    .Cells(2, 16).ClearContents
    Application.EnableEvents = True
    .Unprotect
    '.Range(sHide2 & 1).EntireColumn.Hidden = True
    .Range(sHide2).EntireColumn.Hidden = True
    .Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
        False, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
        AllowFormattingRows:=True, AllowSorting:=True, AllowFiltering:=True, _
        AllowUsingPivotTables:=True
    .EnableSelection = xlUnlockedCells
End With

With Sheet5
    Application.EnableEvents = False
    .Cells(1, 17).ClearContents
    Application.EnableEvents = True
    .Unprotect
    '.Range(sHide2 & 1).EntireColumn.Hidden = True
    .Range(sHide2).EntireColumn.Hidden = True
    .Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
        False, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
        AllowFormattingRows:=True, AllowSorting:=True, AllowFiltering:=True, _
        AllowUsingPivotTables:=True
    .EnableSelection = xlUnlockedCells
End With

     UserForm1.Show

  'Enable Timers on Workbook Open
  bGblInhibitTimers = False

  'Stop all timers
  On Error Resume Next
  Application.OnTime RunWhen, "SaveAndClose", , False
  Application.OnTime RunStatusBarWhen, "TimeTilExitTimer", , False
  On Error GoTo 0
 
  'Arm Timer to save and close workbook
  RunWhen = Now + TimeSerial(0, NUM_MINUTES, NUM_SECONDS)
  Application.OnTime RunWhen, "SaveAndClose", , True

  'Arm Timer to display time remaining
  RunStatusBarWhen = Now + TimeSerial(0, 0, STATUS_BAR_REFRESH_TIME_IN_SECONDS)
  Application.OnTime RunStatusBarWhen, "TimeTilExitTimer", , True

 Application.Iteration = True
  Application.MaxIterations = 1
  Application.MaxChange = 0.001
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    On Error Resume Next
    Application.OnTime RunWhen, "SaveAndClose", , False
    On Error GoTo 0
    
    'Display Time Remaining Only When timers are enabled
    If bGblInhibitTimers = False Then
      RunWhen = Now + TimeSerial(0, NUM_MINUTES, NUM_SECONDS)
      Application.OnTime RunWhen, "SaveAndClose", , True
    End If
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, _
    ByVal Target As Range)

    On Error Resume Next
    Application.OnTime RunWhen, "SaveAndClose", , False
    
    On Error GoTo 0
    'Display Time Remaining Only When timers are enabled
    If bGblInhibitTimers = False Then
      RunWhen = Now + TimeSerial(0, NUM_MINUTES, NUM_SECONDS)
      Application.OnTime RunWhen, "SaveAndClose", , True
    End If

End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)

' Hide all sheets except the splash sheet
SHideAllSheets

'Stop all timers
  On Error Resume Next
  Application.OnTime RunWhen, "SaveAndClose", , False
  Application.OnTime RunStatusBarWhen, "TimeTilExitTimer", , False
  On Error GoTo 0
  
  'Disable 'Save Cancel' if Called from Here
  bGblDoNotCancelIfCalledFromCloseEvent = True

  'Clear the Status Bar
  Application.StatusBar = ""
'Sheet16.Visible = True    ' redundant
'Sheet16.Select               ' redundant

End Sub


Sub SHideAllSheets()

Dim ws As Worksheet
' global constant
' Const wsWarningSheet As String = "Splash"

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False

For Each ws In ThisWorkbook.Sheets
    If ws.Name = wsWarningSheet Then
        ws.Visible = True
    Else
        ws.Visible = xlVeryHidden
    End If
Next

ThisWorkbook.Save

Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True

Sheet16.Visible = True
Sheet16.Select
End Sub

**Kevin#** · 04-03-2016, 07:06 AM

You appear to have put the code in the correct place the first time.

Here is a dummy file so that you can see the code working.
When you open the file {ctrl} {shift} + T unhides all the sheets
then {ctrl} + T hides them one by one with a message box so that you can see them close, ending up on "Splash" and then vba Saves and Close

To work out why it is not working for you:
Suggest you put a couple of message boxes (where indicated below) in your code so that you can see where it is not doing what is should be doing. The code may not be following the path you think it is. Hopefully these will give you a clue.
(include the MsgBox lines as they are)

Application.StatusBar = False
MsgBox "After StatusBar"

For Each ws In ThisWorkbook.Worksheets
MsgBox ws.Name

Report back if working or not

**Nitro2481** · 04-03-2016, 08:24 AM

Hi Kevin,

Thanks a mil for your patience. I think I have it working with your first part of code.

Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
    If ws.Name <> "Splash" Then ws.Visible = xlVeryHidden
Next ws

The second part seems to be causing errors. Do I require this second part for any reason? Sheets are already programmed to unhide depending on who logs in. Your bit ensures all sheets return to hidden when timer runs out. I just want to make sure I'm not leaving myself open by leaving the second part out.

For Each ws In ThisWorkbook.Worksheets
    ws.Visible = xlSheetVisible
Next ws

Option Explicit
'Module1
Public bGblInhibitTimers As Boolean
Public RunWhen As Double
Public RunStatusBarWhen As Double
Public Const NUM_MINUTES = 10
Public Const NUM_SECONDS = 0
Public Const STATUS_BAR_REFRESH_TIME_IN_SECONDS = 1

Public Sub StopTimers()
  'This is used for debugging purposes to shut down the timers

  bGblInhibitTimers = True
  On Error Resume Next
  Application.OnTime RunWhen, "SaveAndClose", , False
  Application.OnTime RunStatusBarWhen, "TimeTilExitTimer", , False
  On Error GoTo 0
 
  Application.StatusBar = "Timers stopped by StopTimers()."


End Sub

Public Sub SaveAndClose()

  'Tell the time remaining timer to stop
  bGblInhibitTimers = True
  
  On Error Resume Next
  Application.OnTime RunStatusBarWhen, "TimeTilExitTimer", , False
  On Error GoTo 0
  'Debug.Print "bGblInhibitTimers = true in SaveAndClose() at " & Now
  
  'Return control of the Status Bar to Excel
  Application.StatusBar = ""
  Application.StatusBar = False
  Sheets("Splash").Visible = xlSheetVisible
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
    If ws.Name <> "Splash" Then ws.Visible = xlVeryHidden
Next ws
  ThisWorkbook.Close savechanges:=True
End Sub

Sub TestTime()
  RunWhen = Now + TimeSerial(0, NUM_MINUTES, NUM_SECONDS)
  Debug.Print Format(RunWhen, "mm/dd/yy hh:mm:ss AM/PM")
End Sub
Sub TimeTilExitTimer()
  'This displays a time until exit message

  Const SECONDS_PER_DAY = 86400#
  Const SECONDS_PER_MINUTE = 60#
  
  Dim sMessage As String
  Dim ySecondsTimeToExit As Double
  Dim yMinutes As Double
  Dim ySeconds As Double

  Dim myTime As Date
  
  'Get the current date and time
  myTime = Now()
  
  'Calculate the number of seconds remaining to shut down
  ySecondsTimeToExit = SECONDS_PER_DAY * (RunWhen - myTime)
  
  'Check for Integrity Error - RunWhen = 0
  'Should Never Happen - Shut Down the refresh timer
  If ySecondsTimeToExit < 0 Then
    bGblInhibitTimers = True
    Application.StatusBar = "Software Integrity Error - Time Remaining Display discontinued."
  End If
  
  If ySecondsTimeToExit <= 99 Then
    sMessage = "Program will time out and exit in " & Format(ySecondsTimeToExit, "0") & " Seconds."
  Else
    yMinutes = Int(ySecondsTimeToExit / SECONDS_PER_MINUTE)
    ySeconds = Int(ySecondsTimeToExit - 60 * yMinutes)
    If yMinutes > 0 And ySeconds >= 60 Then
      yMinutes = yMinutes + 1
      ySeconds = ySeconds - 60
    End If
    
    sMessage = "Program will time out and exit at " & Format(RunWhen, "hh:mm:ss AM/PM") & " in " & _
                Format(yMinutes, "0") & " Minutes " & Format(ySeconds, "0") & " Seconds."
  End If
  
  
  If bGblInhibitTimers = True Then
    'Return control of the Status Bar to Excel
    Application.StatusBar = ""
    Application.StatusBar = False
    'Debug.Print "bGblInhibitTimers = true in TimeTilExitTimer() at " & Now

  Else
    Application.DisplayStatusBar = True
    Application.StatusBar = sMessage

    RunStatusBarWhen = Now + TimeSerial(0, 0, STATUS_BAR_REFRESH_TIME_IN_SECONDS)
    Application.OnTime RunStatusBarWhen, "TimeTilExitTimer", , True
    'Debug.Print "bGblInhibitTimers = false in TimeTilExitTimer() at " & Now
  End If

End Sub

**Kevin#** · 04-03-2016, 08:26 AM

Put the second part in another standalone subroutine - it is there to allow you to unhide all sheets

**Nitro2481** · 04-03-2016, 08:54 AM

Hi Kevin,

Have that working perfectly. Thanks a million for your help.

**Kevin#** · 04-03-2016, 09:47 AM

Glad you got it working.
You puzzled out where the problem was for yourself - that's the only way to gain a real understanding of VBA.
Thanks for the reps

Closing WB with a timer no changing sheets to very hidden

LinkBack

Thread Tools

Rate This Thread

Display

Hybrid View

Closing WB with a timer no changing sheets to very hidden

Re: Closing WB with a timer no changing sheets to very hidden

Re: Closing WB with a timer no changing sheets to very hidden

Re: Closing WB with a timer no changing sheets to very hidden

Re: Closing WB with a timer no changing sheets to very hidden

Re: Closing WB with a timer no changing sheets to very hidden

Re: Closing WB with a timer no changing sheets to very hidden

Re: Closing WB with a timer no changing sheets to very hidden

Re: Closing WB with a timer no changing sheets to very hidden

Re: Closing WB with a timer no changing sheets to very hidden

Re: Closing WB with a timer no changing sheets to very hidden

Thread Information

Users Browsing this Thread

Similar Threads

[SOLVED] Sheets not changing to Very hidden when timer runs out

Timer Macro Auto Closing Files

[SOLVED] Closing a workbook with the menu hidden

How to have open a hidden sheet / hide on closing

[SOLVED] Format all cells in all sheets to Protection Hidden on visible and hidden tabs

[SOLVED] trying to access the excel sheets/Tabs in the hidden/very hidden mode through hyperlinks

Changing a csv format to xls and saving/closing

Bookmarks

Bookmarks

Posting Permissions