PDA

View Full Version : Time limit



ahn
10-05-2011, 06:51 AM
I am using the following procedure to force users to enable macros when loading the worksheet

Option Explicit
Const Prompt = "Prompt"

Private Sub Workbook_BeforeClose(Cancel As Boolean)
'Turn off events to prevent unwanted loops
Application.EnableEvents = False

'Evaluate if workbook is saved and emulate default propmts
With ThisWorkbook
If Not .Saved Then
Select Case MsgBox("Do you want to save the changes you made to '" & .Name & "'?", _
vbYesNoCancel + vbExclamation)
Case Is = vbYes
'Call customized save routine
Call CustomSave
Case Is = vbNo
'Do not save
Case Is = vbCancel
'Set up procedure to cancel close
Cancel = True
End Select
End If

'If Cancel was clicked, turn events back on and cancel close,
'otherwise close the workbook without saving further changes
If Not Cancel = True Then
.Saved = True
Application.EnableEvents = True
.Close SaveChanges:=False
Else
Application.EnableEvents = True
End If
End With
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'Turn off events to prevent unwanted loops
Application.EnableEvents = False

'Call customized save routine and set workbook's saved property to true
'(To cancel regular saving)
Call CustomSave(SaveAsUI)
Cancel = True

'Turn events back on an set saved property to true
Application.EnableEvents = True
ThisWorkbook.Saved = True
End Sub
Private Sub Workbook_Open()
'Unhide all worksheets
Dim valid As Integer
valid = Range("valid")
If valid <> 1 Then Exit Sub
Application.ScreenUpdating = False
Call ShowAllSheets
Application.Goto Reference:="introduction"
Application.ScreenUpdating = True
End Sub
Private Sub CustomSave(Optional SaveAs As Boolean)
Dim ws As Worksheet, aWs As Worksheet, newFname As String
'Turn off screen flashing
Application.ScreenUpdating = False

'Record active worksheet
Set aWs = ActiveSheet

'Hide all sheets
Call HideAllSheets

'Save workbook directly or prompt for saveas filename
If SaveAs = True Then
newFname = Application.GetSaveAsFilename( _
fileFilter:="Excel Files (*.xls), *.xls")
If Not newFname = "False" Then ThisWorkbook.SaveAs newFname
Else
ThisWorkbook.Save
End If

'Restore file to where user was
Call ShowAllSheets
aWs.Activate

'Restore screen updates
Application.ScreenUpdating = True
End Sub
Private Sub HideAllSheets()
'Hide all worksheets except the macro welcome page
Dim ws As Worksheet

Worksheets(Prompt).Visible = xlSheetVisible

For Each ws In ThisWorkbook.Worksheets
ws.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, _
AllowFormattingColumns:=True, _
AllowFormattingRows:=True, _
Password:=Range("ahn")
Next ws

For Each ws In ThisWorkbook.Worksheets
If Not ws.Name = Prompt Then ws.Visible = xlSheetVeryHidden
Next ws

Worksheets(Prompt).Activate
Worksheets(Prompt).ScrollArea = ""
Application.Goto Reference:="prompt"
ActiveWindow.DisplayWorkbookTabs = False
End Sub
Private Sub ShowAllSheets()
'Show all worksheets except the macro welcome page

Dim ws As Worksheet

For Each ws In ThisWorkbook.Worksheets
ws.Visible = xlSheetVisible
ws.EnableOutlining = True
ws.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, _
AllowFormattingColumns:=True, _
AllowFormattingRows:=True, _
Password:=Range("ahn"), _
userinterfaceonly:=True
Next ws

ActiveWindow.DisplayWorkbookTabs = True
Worksheets(Prompt).Visible = xlSheetVeryHidden

End Sub


I would like to add a time limit in the sheet to do the following

unprotect and delete a specific sheet
save the workbook without confirmation
return to the "prompt" page

Many thanks for any help

Bob Phillips
10-05-2011, 08:05 AM
Record a macro to do all that, it will provide the code that you need.

mikerickson
10-05-2011, 09:36 AM
If the user hasn't enabled macros within the time limit, the timer macro will never run.