Protection Object Example

The following routine sets Protection options based on the user name associated with the application (found in the Popular section of the Excel Options dialog box) and that user's settings on a table on the worksheet. If the user isn't found, a message appears and the default settings are used:

Sub ProtectionSettings()

Dim rngUsers As Range, rngUser As Range Dim sCurrentUser As String

'Grab the current username sCurrentUser = Application.UserName

'Define the list of users in the table With wksAllowEditRange

Set rngUsers = .Range(.Range("Users"), .Range("Users").End(xlToRight)) End With

'Locate the current user on the table Application.FindFormat.Clear

Set rngUser = rngUsers.Find(What:=sCurrentUser, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False)

'If current user is found on the table(

If Not rngUser Is Nothing Then

'Set the Protection properties based ' on a table wksAllowEditRange.Protect Password:="wrox1", _ DrawingObjects:=True, _ Contents:=True, _

AllowFormattingCells:=rngUser.Offset(1, 0).Value, _ AllowFormattingColumns:=rngUser.Offset(2, 0).Value, _ AllowFormattingRows:=rngUser.Offset(3, 0).Value, _ AllowSorting:=rngUser.Offset(4, 0).Value, _ UserInterfaceOnly:=True

'Select Unlocked cells, Locked and Unlocked cells, or neither ' is NOT part of the Protection object If rngUser.Offset(5, 0).Value = True Then wksAllowEditRange.EnableSelection = xlUnlockedCells

Else wksAllowEditRange.EnableSelection = xlNoRestrictions End If


'Current user is not on the table

MsgBox "User not found on User Table. Default Options will be used.", vbExclamation, "Protection Settings"

wksAllowEditRange.Protect , True, True, False, False, False, _

False, False, False, False, False, _ False, False, False, False, False wksAllowEditRange.EnableSelection = xlNoRestrictions

End If

End Sub

0 0

Post a comment