Allow access to certain sheets in a workbook

[tomski]

Hi,

I tried the following:

I have a workbook with A Sheet called 'Agenda' and a sheet called 'Tasks'. These two sheets are Always visible.
Then I have a sheet per employee containing their working hours. I used VBA to make sure an employee has to log in in order to see their personal sheet and the two sheets I mentioned before.

I have two questions about this:

- Can I make the visible sheets after the employee logs in 'read only'?
- Is there a way to log in as an admin and unlock all the sheets at once?

I use the following code for the workbook:

P
rivate Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim w As Worksheet
    Dim bSaveIt As Boolean

    bSaveIt = False
    For Each w In Worksheets
        If w.Visible Then
            Select Case w.Name
                Case "employee1"
                    w.Protect ("paswoord1")
                    w.Visible = False
                    bSaveIt = True
                Case "employee2"
                    w.Protect ("paswoord2")
                    w.Visible = False
                    bSaveIt = True
                Case "employee3"
                    w.Protect ("paswoord3")
                    w.Visible = False
                    bSaveIt = True
                Case "employee4"
                    w.Protect ("paswoord4")
                    w.Visible = False
                    bSaveIt = True
                Case "employee5"
                    w.Protect ("paswoord5")
                    w.Visible = False
                    bSaveIt = True
                Case "employee6"
                    w.Protect ("paswoord6")
                    w.Visible = False
                    bSaveIt = True
               
            End Select
        End If
    Next w
    If bSaveIt Then
        ActiveWorkbook.CustomDocumentProperties("auth").Delete
        ActiveWorkbook.Save
    End If
End Sub

Private Sub Workbook_Open()
    UserForm1.Show
End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    If Sh.Name <> "Agenda" Then
    If Sh.Name <> "Tasks" Then
        If Sh.Name <> ActiveWorkbook.CustomDocumentProperties("auth").Value Then
            Sh.Visible = False
            MsgBox "You have no right to view this sheet"
        End If
    End If
    End If
End Sub

I use the following code for the login form:

Dim bOK2Use As Boolean
Private Sub btnOK_Click()
    Dim bError As Boolean
    Dim sSName As String
    Dim p As DocumentProperty
    Dim bSetIt As Boolean
    bOK2Use = False
    bError = True
    If Len(txtUser.Text) > 0 And Len(txtPass.Text) > 0 Then
        bError = False
        Select Case txtUser.Text
            Case "Employee1"
                sSName = "Employee1"
                If txtPass.Text <> "paswoord1" Then bError = True
            Case "Employee2"
                sSName = "Employee2"
                If txtPass.Text <> "paswoord2" Then bError = True
            Case "Employee3"
                sSName = "Employee3"
                If txtPass.Text <> "paswoord3" Then bError = True
            Case "Employee4"
                sSName = "Employee4"
                If txtPass.Text <> "paswoord4" Then bError = True
            Case "Employee5"
                sSName = "Employee5"
                If txtPass.Text <> "paswoord5" Then bError = True
            Case "Employee6"
                sSName = "Employee6"
                If txtPass.Text <> "paswoord6" Then bError = True
            Case Else
                bError = True
        End Select
    End If
    If bError Then
        MsgBox "Not a valid username or password"
    Else
        'Set document property
        bSetIt = False
        For Each p In ActiveWorkbook.CustomDocumentProperties
            If p.Name = "auth" Then
                p.Value = sSName
                bSetIt = True
                Exit For
            End If
        Next p
        If Not bSetIt Then
            ActiveWorkbook.CustomDocumentProperties.Add _
              Name:="auth", LinkToContent:=False, _
              Type:=msoPropertyTypeString, Value:=sSName
        End If
        Sheets(sSName).Visible = True
        Sheets(sSName).Unprotect (txtPass.Text)
        Sheets(sSName).Activate
        bOK2Use = True
        Unload UserForm1
       
       
    End If
End Sub
Private Sub UserForm_Terminate()
    If Not bOK2Use Then
        ActiveWorkbook.Close (False)
    End If
End Sub

Thanks in advance!
Tomski