[Tasos]

Τζίμη,Μπορείς να κλειδώνεις και τα φύλλα με τον κωδικό πχ. "test" χειροκίνητα
ή τροποποιείς τμήματα του κώδικα όπως φαίνεται παρακάτω:

Στην λειτουργική μονάδα "ThisWorkbook:"

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim wks As Object
    ThisWorkbook.Unprotect Password:="test"
    If ShLogin.Visible <> xlSheetVisible Then ShLogin.Visible = xlSheetVisible
    ShLogin.Activate
    For Each wks In ThisWorkbook.Sheets
    wks.Protect Password:="test", DrawingObjects:=True, Contents:=True, Scenarios:=True
        If wks.Visible Then
            If wks.Name <> ShLogin.Name Then
                wks.Visible = xlSheetVeryHidden
            End If
        End If
    Next
    ThisWorkbook.Protect Password:="test", Structure:=True, Windows:=False
    ThisWorkbook.Save
End Sub

Στη φόρμα:

Private Sub cmdOK_Click()
    Dim username As String, userpass As String, IsAdmin As Integer, wks As Object
    With Me.cboAllUsers
        username = .List(.ListIndex, 1)
        userpass = .List(.ListIndex, 2)
        IsAdmin = .List(.ListIndex, 3)
    End With
    If StrComp(userpass, Me.txtPass.Text, vbBinaryCompare) = 0 Then
        Application.ScreenUpdating = False
        ThisWorkbook.Unprotect Password:="test"
        If IsAdmin Then
            ThisWorkbook.Unprotect Password:="test"
            For Each wks In ThisWorkbook.Sheets
                wks.Visible = xlSheetVisible
                wks.Unprotect Password:="test"
            Next
            ShUserNames.Activate
            Application.ScreenUpdating = True
        Else
           ThisWorkbook.Sheets(username).Visible = xlSheetVisible
           ThisWorkbook.Sheets(username).Protect Password:="test", DrawingObjects:=True, Contents:=True, Scenarios:=True
            ShLogin.Visible = xlSheetVeryHidden
            ThisWorkbook.Protect Password:="test", Structure:=True, Windows:=False
        End If
        Unload Me
    Else
        Attempts = Attempts + 1
        If Attempts > 3 Then
            MsgBox "Δεν μπορείτε να εισέλθετε στην εφαρμογή." & vbLf & _
                   "Επικοινωνήστε με τον διαχειριστή της εφαρμογής.", vbInformation, ThisWorkbook.Name
            If Workbooks.Count > 1 Then
                ThisWorkbook.Close SaveChanges:=False
            Else
                Application.Quit
            End If
        Else
            Me.txtPass.Text = vbNullString
            Me.txtPass.SetFocus
            MsgBox "Ο κωδικός δεν είναι σωστός! Δοκιμάστε ξανά.", vbExclamation, "Προσοχή!"
        End If
    End If
End Sub

Καλή συνέχεια!

Τάσος