+ Reply to Thread
Results 1 to 4 of 4

Sheets not changing to Very hidden when timer runs out

Hybrid View

  1. #1
    Forum Contributor Nitro2481's Avatar
    Join Date
    09-09-2014
    Location
    Laois, Ireland
    MS-Off Ver
    2013
    Posts
    323

    Sheets not changing to Very hidden when timer runs out

    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 visable 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.

  2. #2
    Administrator 6StringJazzer's Avatar
    Join Date
    01-27-2010
    Location
    Tysons Corner, VA, USA
    MS-Off Ver
    MS 365 Family 64-bit 2505
    Posts
    27,240

    Re: Sheets not changing to Very hidden when timer runs out

    I understand conceptually what you are trying to do but the code seems rather complex. Perhaps that's the way it needs to be; you have obviously spent quite a bit of time building this

    When the file closes as a result of a ThisWorkbook.Close call from the timer expiration, the Workbook_BeforeClose event should fire, just as if the user closed it. Are you saying that doesn't happen? Have you tried stepping through with the debugger from the point of that call?

    I'm not sure what setup needs to happen in the workbook for this code to work. Rather than trying to replicate your file using the right sheet names, etc., can you just attach it? It looks like this code does not deal with data so if the data is private you can simply delete the data before posting.
    Jeff
    | | |·| |·| |·| |·| | |:| | |·| |·|
    Read the rules
    Use code tags to [code]enclose your code![/code]

  3. #3
    Forum Contributor Nitro2481's Avatar
    Join Date
    09-09-2014
    Location
    Laois, Ireland
    MS-Off Ver
    2013
    Posts
    323

    Re: Sheets not changing to Very hidden when timer runs out

    Hi 6StringJazzer

    Yes you are right, I have worked on this workbook and built it up over a couple of years now adding bits as I go. I would not be very strong on VBA so most of what I have done is with the help of people like yourself. I'm not sure how the debugger works?

    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 visable. 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 buit all sheets are visible and accessable. 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
    Attached Files Attached Files
    Last edited by Nitro2481; 03-11-2016 at 08:40 AM.

  4. #4
    Forum Contributor Nitro2481's Avatar
    Join Date
    09-09-2014
    Location
    Laois, Ireland
    MS-Off Ver
    2013
    Posts
    323

    Re: Sheets not changing to Very hidden when timer runs out

    I am closing this and opening a new thread with a different example

+ Reply to Thread

Thread Information

Users Browsing this Thread

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

Similar Threads

  1. Change color of button when timer runs
    By Artos90 in forum Excel Programming / VBA / Macros
    Replies: 1
    Last Post: 01-22-2016, 02:28 AM
  2. My macro runs on hidden sheets (and it shouldn't)
    By nagonar in forum Excel Programming / VBA / Macros
    Replies: 6
    Last Post: 02-09-2015, 11:47 AM
  3. My macro runs on hidden sheets
    By nagonar in forum Excel Programming / VBA / Macros
    Replies: 1
    Last Post: 02-09-2015, 11:20 AM
  4. [SOLVED] Format all cells in all sheets to Protection Hidden on visible and hidden tabs
    By DeRo22 in forum Excel Programming / VBA / Macros
    Replies: 7
    Last Post: 02-28-2014, 03:17 PM
  5. [SOLVED] trying to access the excel sheets/Tabs in the hidden/very hidden mode through hyperlinks
    By Kiran Kurapati in forum Excel Programming / VBA / Macros
    Replies: 5
    Last Post: 12-30-2013, 06:50 AM
  6. help in changing the code that runs on one cell to the whole column
    By hiteshasrani43 in forum Excel Programming / VBA / Macros
    Replies: 7
    Last Post: 06-07-2012, 10:29 AM
  7. Show text message instead of egg timer while macro runs
    By CasualVisitor in forum Excel General
    Replies: 2
    Last Post: 09-25-2009, 02:39 PM

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