I have a timer that closes my workbook after 5 minutes. The issue is when i have another workbook open the workbook with the timer will reopen when i try to close it.
Earlier i had the countdown to "tick" every second but that messed up the view of comments making them blink for every countdown tick. When i had that I didn't see any issues with reopening of the workbook.
I have this in both my module and thisworkbook
Public gCount as Date
These two codes are in my module. The timer is displayed in a cell
(Worksheets("kode").Range("H3")) and counts down every 10 seconds
Sub Timer()
gCount = Now + TimeValue("00:00:10")
Application.OnTime gCount, "ResetTime"
End Sub
Sub ResetTime()
Dim xRng As Range
If ThisWorkbook.Worksheets("kode").Range("H3") = "" Then GoTo Endsub
Set xRng = Application.ThisWorkbook.Worksheets("kode").Range("H3")
xRng.Value = xRng.Value - TimeSerial(0, 0, 10)
If xRng.Value <= 1.15740740740741E-05 Then
Call SavedAndClose
Exit Sub
End If
Call Timer
Endsub:
End Sub
This code is in ThisWorkbook
Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
gCount = Now + TimeValue("00:00:10")
Application.OnTime gCount, "ResetTime", Schedule:=False
ThisWorkbook.Worksheets("Interface").Select
'Hides all sheets but the interface sheet
Sheet2.Visible = False
Sheet3.Visible = False
Sheet6.Visible = False
Sheet7.Visible = False
Sheet8.Visible = False
End Sub
There too is a place where the cell Worksheets("kode").Range("H3") is set to 00:05:01 and a Workbook_SheetSelectionChange where it resets it to 00:05:01
The sheet closes when Worksheets("kode").Range("H3") is at 00:00:01
If i remove the "On Error Resume Next" the code makes a 1004 run-time error when i try to close the workbook.
Hope that someone can help me close my workbook
Best regards
If i remove the "On Error Resume Next" the code makes a 1004 run-time error when i try to close the workbook.
And that is why you should not put On Error Resume Next everywhere to silence errors instead of fixing them.
Application.OnTime can schedule the same procedure multiple times for different times of day. For this reason, it can only unschedule a previously scheduled entry when you provide the exact time for which it was scheduled - if you provide a time for which there is no scheduled entry, you will get a runtime error 1004.
Now + TimeValue("00:00:10") returns a different value each time you call it.
If you want to be able to cancel a previously set entry, store the time in a module-level variable and use that variable for both scheduling and unscheduling. Your module-level gCount variable would do, but:
You have two of them ("I have this in both my module and thisworkbook")
You overwrite the previously stored value with a useless new one right before calling Schedule:=False.
Make sure you only have one gCount, and only assign to it before scheduling a call, not before unscheduling it.
I found an answer to my own comment to GSergs answer:
I made a Msgbox with vbYesNoCancel options and canceled the OnTime event in the Yes and No answer and work around the generic "Save changes" prompt in excel. If Cancel is pressed the macro will cancel.
The "If xRng.Value <= 1.15740740740741E-05 Then" in the beginning insures that if the timer has run out it skips the MsgBox and just saves.
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Set xRng = Application.ThisWorkbook.Worksheets("kode").Range("H3")
If xRng.Value <= 1.15740740740741E-05 Then
Application.ScreenUpdating = False
ThisWorkbook.Worksheets("Interface").Select
'Hides all sheets but the interface sheet
Sheet2.Visible = False
Sheet3.Visible = False
Sheet6.Visible = False
Sheet7.Visible = False
Sheet8.Visible = False
Application.OnTime gCount, "ResetTime", Schedule:=False
If ThisWorkbook.Saved = False Then
ThisWorkbook.Save
End If
Application.ScreenUpdating = True
GoTo Endsub
Else
End If
Dim intValue As Integer
intValue = MsgBox("Do you want to save changes?", 3, "Save changes?")
If intValue = 6 Then
Application.ScreenUpdating = False
ThisWorkbook.Worksheets("Interface").Select
'Hides all sheets but the interface sheet
Sheet2.Visible = False
Sheet3.Visible = False
Sheet6.Visible = False
Sheet7.Visible = False
Sheet8.Visible = False
Application.OnTime gCount, "ResetTime", Schedule:=False
If ThisWorkbook.Saved = False Then
ThisWorkbook.Save
End If
Application.ScreenUpdating = True
ElseIf intValue = 7 Then
Application.ScreenUpdating = False
ThisWorkbook.Worksheets("Interface").Select
'Hides all sheets but the interface sheet
Sheet2.Visible = False
Sheet3.Visible = False
Sheet6.Visible = False
Sheet7.Visible = False
Sheet8.Visible = False
Application.OnTime gCount, "ResetTime", Schedule:=False
ThisWorkbook.Saved = True
Application.ScreenUpdating = True
Else
Cancel = True
End If
End Sub
Hope it can help someone with the same issue.
Best regars
Søren
Related
so I tried the solutions here Excel ScreenUpdating False and still flickering screen but nth worked , im wondering if I should put the screen update in the fucntion I call
Note that the function i call is gonna call another that'll parse data in the sheet once button 2 is clicked,Here's the code I did so far
Private Sub CommandButton2_Click()
Application.ScreenUpdating = False
ButtonOneClick = False
Call SheetName
If ButtonOneClick Then
Me.CommandButton2.Visible = True
Else
Me.CommandButton2.Visible = False
End If
Application.ScreenUpdating = True
End Sub
I've been trying to get the typical hide sheets/unhide sheets code to work for encouraging Macro enabling. Since I lock down saving, I needed to do it slightly differently than putting it in the Workbook_BeforeClose Sub as usually is done.
But...my hide sub
Sub HideSheets()
'Error Handling when workbook is unprotected.
On Error GoTo EH
'Unprotect the workbook to allow conditional formatting changes.
ThisWorkbook.Sheets("Field Service Report").Unprotect Password:="x"
ThisWorkbook.Sheets("Prompt").Unprotect Password:="x"
'Main Sub Code
Application.EnableCancelKey = xlDisabled
Sheets("Prompt").Visible = xlSheetVisible
Sheets("Field Service Report").Visible = xlSheetVeryHidden
Application.EnableCancelKey = xlInterrupt
'Reprotect worksheet before ending sub.
ThisWorkbook.Sheets("Field Service Report").Protect Password:="x", UserInterfaceOnly:=True
ThisWorkbook.Sheets("Prompt").Protect Password:="x"
Exit Sub
EH:
Call EH
Resume Next
End Sub
and my unhide sub
Sub UnhideSheets()
'Error Handling
On Error GoTo EH
'Unprotect the workbook to allow conditional formatting changes.
ThisWorkbook.Sheets("Field Service Report").Unprotect Password:="x"
ThisWorkbook.Sheets("Prompt").Unprotect Password:="x"
'Main Sub Code
Application.EnableCancelKey = xlDisabled
Sheets("Field Service Report").Visible = xlSheetVisible
Sheets("Prompt").Visible = xlSheetVeryHidden
Application.EnableCancelKey = xlInterrupt
'Reprotect worksheet before ending sub.
ThisWorkbook.Sheets("Field Service Report").Protect Password:="x", UserInterfaceOnly:=True
ThisWorkbook.Sheets("Prompt").Protect Password:="x"
Exit Sub
EH:
Call EH
Resume Next
End Sub
....works fine when called form the immediate window. Sheets hide and unhide appropriately.
But, when I step through the sub it doesn't actually do anything. The idea is to set the sheets to the "prompt" sheet before saving, save, then revert to usable after saving. But I can't even see if that code is working correctly (it appears to) because stepping through the actual hide/unhide subs doesn't do anything.
Edit: No errors, just doesn't change any settings to hide or unhide sheets.
Thoughts?
Edit: So given the comments below, my subs work when run from the immediate window and when stepped through via debugger. They hide and unhide the worksheets appropriately. So, the only thing that can be wrong is the code that calls these subs. So, here are two more subs. One is the button code for a save button, and the other is the Workbook_BeforeSave Sub.
Sub Save_Form()
'Error Handling ...
On Error GoTo EH
'Unprotect the workbook ...
ThisWorkbook.Sheets("Field Service Report").Unprotect Password:="x"
'Variable to disable any other save but this button.
Module1.SaveChk = 1
'Code to automatically save a copy ...
Module1.UserPath = Environ("USERPROFILE")
Module1.Path = UserPath & "\Desktop\"
If Module1.EditChk = "Y" Then
Module1.SaveName = "FSR Master"
Else
Module1.SaveName = Range("AF6").Value
End If
ThisWorkbook.SaveAs _
Filename:=Path & SaveName & ".xlsm", _
FileFormat:=52
If Module1.SaveError <> 1 Then
'User Display of Save Success
MsgBox "Filename = " & SaveName & vbNewLine _
& "File is saved to your desktop."
Else
Module1.SaveError = 0
End If
'Reset SaveChk variable
Module1.SaveChk = 0
'Reprotect Worksheet
ThisWorkbook.Sheets("Field Service Report").Protect Password:="x", UserInterfaceOnly:=True
Exit Sub
EH:
Call ErHa
Resume Next
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'Error Handling ...
On Error GoTo EH
'Save Initiation Check
If Module1.SaveChk <> 1 Then
Cancel = True
MsgBox "Please Use Form Save Button", vbOKCancel + vbExclamation, "SAVE CANCELLED"
Exit Sub
End If
If Module1.EditChk <> "Y" Then 'Skips the whole block if EditChk = Y
'Create the final range of cells for checking
Set Module1.Required = Application.Union(Module1.Fixed, Module1.Drive, Module1.Stage)
'Check if all required cells are filled in
If WorksheetFunction.CountA(Module1.Required) < Module1.Required.Count Then
Cancel = True
MsgBox "Please Completed Shaded Cells!", vbOK + vbExclamation, "SAVE CANCELLED"
Module1.SaveError = 1
Else
'Set the report date before saving
Application.EnableEvents = False
Range("AE59") = Format(Now(), "mm-dd-yyyy hh:mm:ss AM/PM")
Application.EnableEvents = True
End If
End If
'Renable Macro Splash Screen Before Save
Call HideSheets
Exit Sub
EH:
Call ErHa
Resume Next
End Sub
I would like to write a code which, before closing the Workbook, sets all the sheets except one cover as very hidden.
I click on the "X" to close the Workbook, the Macro is fired and everything fine.
Then I receive the classic saving form of Excel and, if I click cancel, I receive error 91 - Object variable or With block variable not set.
Could someone explain me why is happening? I used the same code in the past and I did not have this issue
It is interesting because, if there is another excel workbook open at the same time, it works everything fine.
In Tab ThisWorkbook:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.EnableEvents = True
Call my_macro 'defined in a separate module
Application.EnableEvents = False
End Sub
For the sake of clarity in Module 1 the code is following:
Public Sub my_macro()
Application.ScreenUpdating = False
On Error GoTo skip
Dim ws As Worksheet
Sheet8.Visible = True
For Each ws In Worksheets
If ws.Name = "Cover" Then
Else
ws.Visible = xlSheetVeryHidden
End If
Next ws
Sheet8.Select
Range("A1").Select
Application.ScreenUpdating = True
ActiveSheet.EnableSelection = xlNoRestrictions
Application.EnableEvents = True
skip:
Application.EnableEvents = True
End Sub
I have code for Workbook_BeforeClose event. I like how it works now but I have just noticed a problem with Application.Visible = False. When I click Yes, it saves Workbook, when I click No, it does nothing, but when I click Cancel it already done Application.Visible = False and I can't see Excel application. How to fix that?
Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
Application.Visible = False
Application.DisplayFormulaBar = True
ActiveWindow.DisplayHeadings = True
ActiveWindow.DisplayGridlines = True
ThisWorkbook.Unprotect Password:="123456"
ActiveWorkbook.Sheets("Start").Visible = True
ThisWorkbook.Worksheets("Start").Activate
ThisWorkbook.Protect Password:="123456", Structure:=True, Windows:=False
End Sub
Instead of relying on the built-in dialog, try using your own. That way you have more control of what happens and when.
So maybe something like:
Dim closing As Boolean
Private Sub Workbook_BeforeClose(Cancel As Boolean)
If Not closing Then
answer = MsgBox("Save data?", vbYesNoCancel + vbQuestion, "Save data?")
If answer = vbYes Or answer = vbNo Then
closing = True
' your code here
ActiveWorkbook.Close savechanges:=answer = vbYes
Else
Cancel = True
End If
End If
End Sub
I'm using the Application.Ontime command to automatically close a spreadsheet after a period of inactivity (10 minutes).
The following code seems to work in general, however, it appears that if you manually close the sheet yourself, the workbook still seems to be active in the background and at the last designated 'endtime' will open itself so that it can close itself.
This is also evident in the VBA code window as after the CloseWB macro runs and the excel workbook appears to be closed, it is still listed in the VBA project explorer window.
Sub RunTime()
Static EndTime
If Not EndTime = "" Then ActiveWorkbook.Application.OnTime EndTime, "CloseWB", , False
EndTime = Now + TimeValue("00:10:00")
ActiveWorkbook.Application.OnTime EndTime, "CloseWB", , True
End Sub
Sub CloseWB()
Application.DisplayAlerts = False
With ThisWorkbook
.Save
.Close
End With
End Sub
I don't want to completely shutdown excel (application.quit) in case users have other workbooks open but need to try and stop the specific workbook running in the background.
Any ideas?
You need to stop the timer. Declare EndTime as a public variable, then turn the timer off in the Workbook_BeforeClose event.
Option Explicit
Public EndTime As Variant
Sub RunTime()
If Not EndTime = "" Then ActiveWorkbook.Application.OnTime EndTime, "CloseWB", , False
EndTime = Now + TimeValue("00:10:00")
ActiveWorkbook.Application.OnTime EndTime, "CloseWB", , True
End Sub
Sub CloseWB()
Application.DisplayAlerts = False
With ThisWorkbook
.Save
.Close
End With
End Sub
In the Workbook object:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
Application.OnTime earliesttime:=EndTime, procedure:="CloseWB", schedule:=False
End Sub