PDA

View Full Version : Allow access to certain sheets in a workbook



tomski
12-04-2018, 08:05 AM
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

tomski
12-05-2018, 01:58 AM
Maybe the title of my post isn't saying much about the question. Actually it's about permissions to worksheets… So depending on who logs in, certain worksheets should be visible or not and they should be read only or not…

Don't know how to change the title though...