Hidding multiple tabs on an excel workbook with a password

[EmmaTM]

Hi
Is it only possible to hide and password protect mutliple tabs on a workbook with VBA?

Thank you
Emma

 

[scoudny]

Nope, Protect Workbook on the Review ribbon will do the same thing

 

[Jaafar Tribak]

The workbook protection on the Review ribbon tab will only prevent users from altering the workbook structure such as adding/copying/deleting worksheets.

I remember wrinting vba code some time ago for password protecting individual worksheets and unprotecting them via the tabs right click menu.

How many tabs do you need to have hidden (ie:= password protected for viewing) ? and how many tabs are visible?

 

[myall_blues]

@EmmaTM see also my response to your message.

 

[Jaafar Tribak]

Here is a slight modification of the code I had :

File Demo:
SheetsTabPassword.xlsm

The workbook illustrative example above, assumes Sheet Main is the only sheet that is visible. All other sheets are xlSheetVeryHidden.

Code was tested in Excel 2016.






1- Code in the ITabProtect Class Interface Module:

Option Explicit

Public Sub Init()
    '
End Sub

Public Sub AddPasswordToSheet(ByVal Sh As Worksheet, ByVal Password As String)
    '
End Sub

:

2- Code in the frmTabProtect blank UserForm Module:

Option Explicit

Implements ITabProtect

Public WithEvents CmndbButton As CommandBarButton
Private WithEvents oButn As MSForms.CommandButton
Private WithEvents oChk As MSForms.CheckBox
Private WithEvents oCancelButn As MSForms.CommandButton
Private WithEvents cmbrs As CommandBars
Private WithEvents wb As Workbook

#If VBA7 Then
    Private Declare PtrSafe Function CoLockObjectExternal Lib "ole32.dll" (ByVal pUnk As IUnknown, ByVal fLock As Boolean, Optional ByVal fLastUnlockReleases As Boolean) As Long
    Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
    Private Declare PtrSafe Function GetLastActivePopup Lib "user32" (ByVal hwndOwnder As LongPtr) As LongPtr
#Else
    Private Enum LongPtr
        [_]
    End Enum
    Private Declare Function CoLockObjectExternal Lib "ole32.dll" (ByVal pUnk As IUnknown, ByVal fLock As Boolean, Optional ByVal fLastUnlockReleases As Boolean) As Long
    Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
    Private Declare Function GetLastActivePopup Lib "user32" (ByVal hwndOwnder As LongPtr) As LongPtr
#End If

Private oPopup As CommandBarPopup


Private Sub UserForm_Initialize()
    Call BuildUserForm
    Set cmbrs = Application.CommandBars
    Set wb = ThisWorkbook
    Call cmbrs_OnUpdate
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    If CloseMode = 0& Then
        Cancel = True
        Me.Hide
        Me.Controls("textbox").Text = ""
        oChk.Value = 0&
    End If
End Sub

Public Property Get GetPopUp() As CommandBarPopup
    Set GetPopUp = oPopup
End Property

Public Property Set GetPopUp(ByVal vNewValue As CommandBarPopup)
    Set oPopup = vNewValue
End Property

Private Sub Itabprotect_Init()
    Dim oPly As CommandBar, sCaption As String
    Call UnloadForms
    Call RemoveMenu
    Set oPly = Application.CommandBars("Ply")
    Set oPopup = oPly.Controls.Add(msoControlPopup, , , , True)
    oPopup.BeginGroup = True
    sCaption = String(2&, ChrW(&H2593)) & Space(5&) & "View Hidden Worksheets"
    oPopup.Caption = sCaption
End Sub

Private Sub ITabProtect_AddPasswordToSheet(ByVal Sh As Worksheet, ByVal Password As String)
    Dim ofrmTabProtect As frmTabProtect, oButton As CommandBarButton
    Set oButton = oPopup.Controls.Add(msoControlButton, , , , True)
    With oButton
        .Style = msoButtonIconAndCaption
        .Caption = Sh.Name
        .FaceId = 9912&
        .Tag = Password
    End With
    Set ofrmTabProtect = New frmTabProtect
    Call CoLockObjectExternal(ofrmTabProtect, True)
    Set ofrmTabProtect.CmndbButton = oButton
    ofrmTabProtect.Controls("oStorageLabel").Caption = Sh.Name
    Set ofrmTabProtect.GetPopUp = oPopup
End Sub

Private Sub RemoveMenu()
    Dim oPly As CommandBar, sCaption As String
    sCaption = String(2&, ChrW(&H2593)) & Space(5&) & "View Hidden Worksheets"
    Set oPly = Application.CommandBars("Ply")
    On Error Resume Next
        oPly.Controls(sCaption).Delete
    On Error GoTo 0
End Sub

Private Sub UnloadForms()
    Dim oUf As UserForm
    For Each oUf In UserForms
        If Not oUf Is Me Then
            Call CoLockObjectExternal(oUf, False)
            Unload oUf
        End If
    Next oUf
End Sub

Private Sub HideAllSheets()
    Dim oUf As UserForm
    For Each oUf In VBA.UserForms
        ThisWorkbook.Worksheets(oUf.Controls("oStorageLabel").Caption).Visible = xlVeryHidden
    Next oUf
End Sub

Private Sub BuildUserForm()

    Dim oTextBox As MSForms.TextBox, oLabel As MSForms.Label, oStorageLabel As MSForms.Label
    
    Me.Width = 240&
    Me.Height = 100&
    Me.BackColor = &HCCFFFF
    
    Set oTextBox = Me.Controls.Add("Forms.TextBox.1", "TextBox", True)
    With oTextBox
        .Top = 20&
        .Left = 20&
        .Width = (Me.InsideWidth + .Left) / 2&
        .Height = 18&
        .PasswordChar = "*"
        .TabIndex = 1&
    End With
    
    Set oLabel = Me.Controls.Add("Forms.Label.1", "Label", True)
    With oLabel
        .Caption = "Enter Password:"
        .Accelerator = "P"
        .Top = oTextBox.Top - 12&
        .Left = oTextBox.Left
        .AutoSize = True
        .TabIndex = 0&
    End With
    
    Set oChk = Me.Controls.Add("Forms.CheckBox.1", "CheckBox", True)
    With oChk
        .Caption = "Show Password"
        .Accelerator = "S"
        .Top = oTextBox.Top + 4&
        .Left = oTextBox.Left + oTextBox.Width + 5&
        .AutoSize = True
    End With
    
    Set oButn = Me.Controls.Add("Forms.CommandButton.1", "Button", True)
    With oButn
        .Caption = "OK"
        .Accelerator = "K"
        .Top = 5& + oTextBox.Top + oTextBox.Height + 2&
        .Width = 30&
        .Left = (Me.InsideWidth - 30&) / 2&
        .Height = 20&
        .Default = True
        .BackColor = &HCCFFFF
    End With
    
    Set oCancelButn = Me.Controls.Add("Forms.CommandButton.1", "CancelButton", True)
    With oCancelButn
        .Top = -200&
        .TabStop = False
        .Cancel = True
    End With
    
    Set oStorageLabel = Me.Controls.Add("Forms.Label.1", "oStorageLabel", False)

End Sub

Private Sub cmbrs_OnUpdate()

    Static hwnd As LongPtr
    Dim sBuff As String * 256&, lRet As Long, i As Long
    
    On Error Resume Next
    If hwnd <> GetLastActivePopup(Application.hwnd) Then
        lRet = GetClassName(GetLastActivePopup(Application.hwnd), sBuff, 256&)
        If Left(sBuff, lRet) = "Net UI Tool Window" Then
            For i = 1& To Me.GetPopUp.Controls.Count
                If ThisWorkbook.Worksheets(Me.GetPopUp.Controls(i).Caption).Visible = xlSheetVisible Then
                    Me.GetPopUp.Controls(i).Enabled = False
                Else
                    Me.GetPopUp.Controls(i).Enabled = True
                End If
            Next i
        End If
    End If
    hwnd = GetLastActivePopup(Application.hwnd)

End Sub

Private Sub CmndbButton_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
    Me.Tag = Ctrl.Caption & "|" & Ctrl.Tag
    Me.Caption = "View Worksheet:  [" & Ctrl.Caption & "]"
    Me.Controls("textbox").SetFocus
    Me.Show
End Sub

Private Sub oButn_Click()
    Me.Hide
    If Me.Controls("textbox").Text = Split(Me.Tag, "|")(1&) Then
        Call HideAllSheets
        With ThisWorkbook.Worksheets(Split(Me.Tag, "|")(0&))
            .Visible = True
            .Activate
        End With
    Else
        MsgBox "The password you supplied is not correct." & _
        "Verify that the CAPS LOCK key is off and be sure to use the correct capitalization.", vbCritical
    End If
    Me.Controls("textbox").Text = ""
    oChk.Value = 0&
End Sub

Private Sub oChk_Change()
    Me.Controls("textbox").PasswordChar = Chr(Asc("*") * (oChk.Value + 1&))
    Me.Controls("textbox").SetFocus
End Sub

Private Sub oCancelButn_Click()
    Me.Hide
End Sub

Private Sub wb_Deactivate()
    Dim sCaption As String
    sCaption = String(2&, ChrW(&H2593)) & Space(5&) & "View Hidden Worksheets"
    On Error Resume Next
    Application.CommandBars("Ply").Controls(sCaption).Delete
    Unload Me
End Sub

Private Sub wb_BeforeClose(Cancel As Boolean)
    Call HideAllSheets
    wb.Save
End Sub

3- Code Usage example in the ThisWorkbook Module:

Option Explicit

Private Sub Workbook_Activate()
    Call ProtectTabs
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    Call ProtectTabs
End Sub

Private Sub ProtectTabs()
    Dim oTabPtrotection As ITabProtect
    Set oTabPtrotection = New frmTabProtect
    With oTabPtrotection
        .Init
        .AddPasswordToSheet Sh:=Sheets("Peter"), Password:="2"
        .AddPasswordToSheet Sh:=Sheets("Claire Gibbard"), Password:="3"
        .AddPasswordToSheet Sh:=Sheets("Jaafar Tribak"), Password:="4"
        .AddPasswordToSheet Sh:=Sheets("Bob Taylor"), Password:="5"
        .AddPasswordToSheet Sh:=Sheets("Arijit Kumar"), Password:="6"
    End With
End Sub