I have (3) sheets in a workbook that should not be seen unless a password is entered. I found a post here that helped me write the below code to accomplish this:
Option Explicit
Option Compare Text
'Password to unhide sheets
Const pWord = "MyPassword"
Sub HideSheets()
'Set worksheet to Very Hidden so that it can only be unhidden by a macro
Worksheets("Castle").Visible = xlSheetVeryHidden
Worksheets("Hibbert").Visible = xlSheetVeryHidden
Worksheets("Laroche").Visible = xlSheetVeryHidden
End Sub
Sub ShowSheets()
'Prompt the user for a password and unhide the worksheet if correct
Select Case InputBox("Please enter the password to unhide the sheet", _
"Enter Password")
Case Is = pWord
With Worksheets("Castle")
.Visible = xlSheetVisible
.Activate
.Range("A1").Select
End With
With Worksheets("Hibbert")
.Visible = xlSheetVisible
.Activate
.Range("A1").Select
End With
With Worksheets("Laroche")
.Visible = xlSheetVisible
.Activate
.Range("A1").Select
End With
Case Else
MsgBox "Sorry, that password is incorrect!", _
vbCritical + vbOKOnly, "You are not authorized!"
End Select
End Sub
In the “This Workbook” object I have the following code:
Option Explicit
Private Sub Workbook_Open()
'Turn off screen updates
Application.ScreenUpdating = False
'Hide confidential sheet at startup
Call HideSheets
'Activate cell A1 on the Dashboard sheet at startup
With Worksheets("Dashboard")
.Activate
.Range("A1").Select
End With
'Restore screen updates
Application.ScreenUpdating = True
The above code works perfectly if the end user enables Macros but if they do not they see everything my Macros are trying to hide. To correct that I found the below code, which forces the user to enable macros when they open my workbook. But I cannot figure out how to have the two workbook macros work together so that first the user must enable macros to be able to view the “Dashboard” worksheet and then still have all the other worksheets hidden until they run the Macro to remove the very hidden property. Also, do you know how to add: (UpdateLinks:=3), so that links automatically are updated when the workbook is opend.
Option Explicit
Const WelcomePage = "Dashboard"
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
Application.ScreenUpdating = False
Call ShowAllSheets
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(WelcomePage).Visible = xlSheetVisible
For Each ws In ThisWorkbook.Worksheets
If Not ws.Name = WelcomePage Then ws.Visible = xlSheetVeryHidden
Next ws
Worksheets(WelcomePage).Activate
End Sub
Private Sub ShowAllSheets()
'Show all worksheets except the macro welcome page
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
If Not ws.Name = WelcomePage Then ws.Visible = xlSheetVisible
Next ws
Worksheets(WelcomePage).Visible = xlSheetVeryHidden
End Sub
Reply With Quote
