How to VeryHidden pages using the current vba code

Itzvenom

New Member
Joined
Nov 12, 2016
Messages
6
Hello 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

  • sheets.jpg
    sheets.jpg
    23.8 KB · Views: 29
Last edited by a moderator:

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.
How about
Rich (BB code):
Private Sub ShowAllSheets()
'Show all worksheets except the macro welcome page

Dim ws As Worksheet

For Each ws In ThisWorkbook.Worksheets
    Select Case ws.Name
        Case "Sheet1", "Sheet2", "Sheet3"
        Case Else
            ws.Visible = xlSheetVisible
    End Select
Next ws

Worksheets(WelcomePage).Visible = xlSheetVeryHidden
End Sub
Change the values in red to match the sheet names you want to remain very hidden
 
Upvote 0
How about
Rich (BB code):
Private Sub ShowAllSheets()
'Show all worksheets except the macro welcome page

Dim ws As Worksheet

For Each ws In ThisWorkbook.Worksheets
    Select Case ws.Name
        Case "Sheet1", "Sheet2", "Sheet3"
        Case Else
            ws.Visible = xlSheetVisible
    End Select
Next ws

Worksheets(WelcomePage).Visible = xlSheetVeryHidden
End Sub
Change the values in red to match the sheet names you want to remain very hidden

Just tried, gives me syntax error and goes back to showing only WelcomePage "Macros"
 
Upvote 0
What was the error & what part of the code was highlighted?

Can you also post the modified code, showing your sheet names.
 
Upvote 0
Glad you sorted it & thanks for the feedback
 
Upvote 0

Forum statistics

Threads
1,224,822
Messages
6,181,165
Members
453,021
Latest member
Justyna P

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top