Solved: Code for Protecting a Specific Sheet in a Workbook with a Password on Exit

[DaveyBoy9]

Hey,

I have a workbook which has a userform with a username and password scenerio. There are access levels to determine what the user can do on the sheet.
when a certain access user logs in it unprotects a sheet.
Does anyone know a code to protect the sheet on exit? Obviously if I dont have this code, user 1 with full access will come and unlock it and make changes then when he logs off user 2 can log on and access everything even though he supposed to have no access.

Thanks in Advance

Dave

[lotuxel]

There are many way to process it. to better figure out of your file, pls attach.
Rgs,
Lotuxel

[DaveyBoy9]

The file is too big to attach.
To make it simple, what i am looking for is a piece of code so that when the user clicks on a button that says read only on it, it opens the file in a read only format.

Thanks

Dave

[Aussiebear]

Try the following.
[VBA]Sub cmdBtn1_Click()
SetAttr "C:My DocumentsExpenses.xls", vbReadOnly
Workbooks.Open Filename:="C:My DocumentsExpenses.xls"
End Sub[/VBA]

Just change the file path name.

[DaveyBoy9]

Thanks for the feeback. Tried the code but when i click the button nothing happens. My code is as below:

[VBA]Private Sub CboUSER_Change()
'// Login Page1
' Trap if user = blank
If Me.CboUSER.ListIndex = -1 Or Me.CboUSER = "" Then Exit Sub
Me.CboUSER.Text = Trim(Me.CboUSER.Text)
Me.Txtpassword.Enabled = True
Me.Txtpassword.SetFocus
End Sub
Private Sub cmdlogin_Click()
'// Login Page1
' If User passes test then get the access level for that user
Dim UserPass As String
Dim AccessLevel As Integer
Dim ws As Worksheet
Dim pass As String
Set ws = Worksheets("USERS")
pass = "treelinks"
With CboUSER
If .ListIndex = -1 Then 'prop Value set to comp/match excel will handle Invalid calls
UserPass = "Fooled1234" 'Set dummy pass if CboUser = ""
Else
UserPass = ws.Range("USERS").Cells(.ListIndex + 1, 2).Value
AccessLevel = ws.Range("USERS").Cells(.ListIndex + 1, 3).Value
End If
End With
If Me.Txtpassword.Text = UserPass Then
MsgBox "You Are Now Logged In As " & CboUSER 'change to suit
Select Case AccessLevel
Case 1
Worksheets("CURRENT").Visible = True
Worksheets("TEST").Visible = True
Case 2
Worksheets("CURRENT").Visible = True
Worksheets("USERS").Visible = True
Worksheets("TEST").Visible = True
Case 3
Worksheets("CURRENT").Visible = True
Worksheets("USERS").Visible = True
Worksheets("TEST").Visible = True
Set ws = Worksheets("HOME")
With ws
.Activate
End With
End Select
Unload Me
Else
MsgBox "Incorrect Password Try Again !"
Me.Txtpassword = ""
Me.Txtpassword.SetFocus
cmdlogin.Enabled = False
End If
End Sub
Private Sub CommandButton1_Click()
'// Login Page1 cancel button
'// Get out! dont save changes user has cancelled
ThisWorkbook.Saved = True 'save any changes
Worksheets("CURRENT").Protect Password = "treelinks"
Unload Me
ThisWorkbook.Close
Application.Quit
End Sub
Private Sub readyonlycmd_Click()
SetAttr "\\princes.co.uk\CoreData\Home\David.Thair\Desktop\Approved Supplier List..xlsm", vbReadOnly
Workbooks.Open Filename:="\\princes.co.uk\CoreData\Home\David.Thair\Desktop\Approved Supplier List..xlsm"
End Sub

Private Sub Txtpassword_AfterUpdate()
'// Page1 Login page password
cmdlogin.Enabled = True
End Sub
Private Sub UserForm_Initialize()
'// Load the combobox with defined name USERS
' Resize the list if any more users added
Dim ws As Worksheet
Set ws = Worksheets("USERS")
With ws
Me.CboUSER.List = ws.Range("USERS").Resize(, 2).Value
Me.Txtpassword.Enabled = False
End With
cmdlogin.Enabled = False
End Sub
' Stop the user closing the form disable the X close
Private Sub UserForm_QueryClose(Cancel As Integer, _
CloseMode As Integer)
If CloseMode = vbFormControlMenu Then
Cancel = True
MsgBox "Please use the Cancel or Exit Button !"
End If
End Sub[/VBA]

Thanks in advance!

Dave