• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Vba code to have multiple warning sheets visible in protected workbook

ichristan21

New Member
Hi everyone,

I found the below code online and was able to integrate it in my workbook however the code is able to open only one warning sheet (Dashboard), this warning sheet is the only sheet that is kept visible during workbook open and workbook beforeclose event. Could anyone help me to modify the code to have multiple warning sheets? Warning Sheet to be Visible must be Sheets Sem1 Database, Sem2 Database, Sem3 Database and Dashboard, other sheet kept hidden. THANKS!
Code:
[Option Explicit]
Option Compare Text
Dim oSht As Object
Dim ws As Worksheet
Dim cControl As CommandBarButton
Private Const MaxUses As Long = 20  '<- change uses
Private Const wsWarningSheet As String = "Dashboard"
Private Sub Workbook_BeforeClose(Cancel As Boolean)
'hide all sheets except warning sheet

    For Each ws In ActiveWorkbook.Sheets
    Application.ScreenUpdating = False
    Application.ExecuteExcel4Macro "Show.ToolBar(""Ribbon"", False)"
    ThisWorkbook.Protect Structure:=False, Windows:=False, Password:="ÔÔ;<«Ð71ÏвU#¶evyÿBë"
 
        If ws.Name = wsWarningSheet Then
            ws.Visible = True
        Else
        ws.Visible = xlVeryHidden
 
        End If
    Next
    'record opening in remote cell
    Sheets("Dashboard").Range("A2") = ""
 
    Application.GoTo Reference:=['Dashboard'!A1]
 
    With ActiveWindow
        .DisplayHeadings = False
        .DisplayZeros = False
        .DisplayHorizontalScrollBar = False
        .DisplayVerticalScrollBar = False
        .DisplayWorkbookTabs = False
     
     
    End With
    With Application
        .DisplayFormulaBar = False
        .DisplayStatusBar = False
     
    End With
    With Sheets(wsWarningSheet).Cells(Rows.Count, Columns.Count)
    End With
 
    frmPassword.Show vbModeless
    Application.Visible = False
    Application.ScreenUpdating = True
 
[/End Sub]
[Private Sub Workbook_Open()]
    Dim ws As Worksheet
    Application.ScreenUpdating = False
    Application.GoTo Reference:=['Dashboard'!A1]
    Application.ExecuteExcel4Macro "Show.ToolBar(""Ribbon"", False)"

'Limit Scrolling Area in worksheets'
    Worksheets("Matrix").ScrollArea = "A1:Y115"
    Worksheets("Settings").ScrollArea = "A1:AC66"
    'Worksheets("Sem3 Database").ScrollArea = "A1:AI506"
    'Worksheets("Sem2 Database").ScrollArea = "A1:AI506"
    'Worksheets("Sem1 Database").ScrollArea = "A1:AI506"
    'Worksheets("Sem1").ScrollArea = "A1:AAP502"
    'Worksheets("Sem2").ScrollArea = "A1:AAP502"
    'Worksheets("Sem3").ScrollArea = "A1:AAP502"

        For Each ws In ActiveWorkbook.Worksheets
            If ws.Name <> "Dashboard" Then
                ws.Visible = xlSheetVeryHidden
             
            End If
        Next ws
        With ActiveWindow
        ActiveSheet.Protect Password:="ÔÔ;<«Ð71ÏвU#¶evyÿBë", AllowFiltering:=True, AllowFormattingColumns:=True, AllowFormattingRows:=True, AllowSorting:=False, UserInterFaceOnly:=True
            .DisplayHeadings = False
            .DisplayZeros = False
            .DisplayHorizontalScrollBar = False
            .DisplayVerticalScrollBar = False
            .DisplayWorkbookTabs = False
         
        End With
        With Application
            .DisplayFormulaBar = False
            .DisplayStatusBar = False
        End With

 
    frmPassword.Show vbModeless
    Application.Visible = False
    Application.ScreenUpdating = True
[/End Sub]
 
Back
Top