Hello everyone,
I'm currently using a VBA code that looks like this
Although I'm trying to make some other sheets very hidden (you can see the worksheet names on the photo attached) along with the Macros page once the authorization is been pass, any help?
Thanks everyone,
I'm currently using a VBA code that looks like this
VBA Code:
Option Explicit
' 'http://www.vbaexpress.com/kb/getarticle.php?kb_id=379
Const WelcomePage = "Macros"
Private Sub Workbook_Open()
bQuit
'Unhide all worksheets
Application.ScreenUpdating = False
Call ShowAllSheets
Application.ScreenUpdating = True
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim answer As VbMsgBoxResult
If Application.Calculation = xlCalculationAutomatic Then
If ThisWorkbook.Saved = False Then
Application.Calculation = xlCalculationManual
answer = MsgBox("Do you want to save the changes you made to " & ThisWorkbook.Name & "?", vbYesNoCancel)
If answer = vbYes Then
Call HideAllSheets
ThisWorkbook.Close True
ElseIf answer = vbNo Then
ThisWorkbook.Close False
ElseIf answer = vbCancel Then
Application.Calculation = xlCalculationAutomatic
Cancel = True
End If
End If
End If
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
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
' http://www.vbaexpress.com/forum/showthread.php?p=271128
Private Sub bQuit()
Dim User As String, passWord As String
User = "BHXBHDTS4GA7620;DESKTOP-KRT2UCQ" 'separate with ";"
If CBool(InStr(1, User, Environ("DESKTOP-KRT2UCQ;BHXBHDTS4GA7620") & ";")) Then
'workbbok is enabled show its content
Else
passWord = InputBox("Password for Manual Access:", vbCritical, "Automatic Access Denied - Last Chance")
If passWord <> "ken" Then ThisWorkbook.Close
End If
End Sub
Sub test()
Dim sh As Worksheet
For Each sh In Worksheets
If sh.Name <> "Modelo - Resumo" Then sh.Visible = xlSheetHidden
Next
End Sub
Although I'm trying to make some other sheets very hidden (you can see the worksheet names on the photo attached) along with the Macros page once the authorization is been pass, any help?
Thanks everyone,
Attachments
Last edited by a moderator: