в 16:33, 26 мая 2010

2010-05-26T16:33:00Z

Admin: 1 версия

2010-05-26T12:47:52Z

1 версия

Новая страница

==Add protection to Worksheet==



<source lang="vb">

Sub Set_Protection()
On Error GoTo errorHandler
Dim myDoc As Worksheet
Dim cel As Range
Set myDoc = ActiveSheet
myDoc.Unprotect
For Each cel In myDoc.UsedRange
cel.Locked = True
cel.Font.ColorIndex = xlColorIndexAutomatic
Next
myDoc.Protect
Exit Sub
errorHandler:
MsgBox Error
End Sub
</source>

==Add user edit range==



<source lang="vb">

Sub AddUserEditRange()
Dim ws As Worksheet, aer As AllowEditRange
Set ws = ThisWorkbook.Sheets("Protection")
ws.Unprotect "Excel2003"
Set aer = ws.Protection.AllowEditRanges.Add("User Range", ws.Range("A1:D4"))
aer.Users.Add "Power Users", True
ws.Protect "Excel2003"
End Sub
</source>

==Formulas Protection==



<source lang="vb">

Sub ProtectFormulas()
Dim ws As Worksheet, rng As Range
Set ws = ThisWorkbook.Sheets("Protection")
ws.Unprotect
" Get each used cell in the worksheet.
For Each rng In ws.UsedRange
" If it contains a formula, lock the cell.
If InStr(rng.Formula, "=") Then
rng.Locked = True
" Otherwise unlock the cell.
Else
rng.Locked = False
End If
Next
ws.Protect "Excel2003"
End Sub
</source>

==Protecting Worksheet Assets with the Protect Method==



<source lang="vb">

Sub TestProtection()
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets(1)
If Not ProtectWorksheet(ws, "TestPassword") Then
Debug.Print "The worksheet could not be protected."
Else
Debug.Print "The worksheet has been protected."
End If
If UnprotectWorksheet(ws, "TestPassword") Then
Debug.Print "The worksheet has been unprotected."
Else
Debug.Print "The worksheet could not be unprotected."
End If
Set ws = Nothing
End Sub
Function ProtectWorksheet(ws As Worksheet, sPassword As String) As Boolean
On Error GoTo ErrHandler
If Not ws.ProtectContents Then
ws.Protect sPassword, True, True, True
End If
ProtectWorksheet = True
Exit Function
ErrHandler:
ProtectWorksheet = False
End Function
Function UnprotectWorksheet(ws As Worksheet, sPassword As String) As Boolean
On Error GoTo ErrHandler
If ws.ProtectContents Then
ws.Unprotect sPassword
End If
UnprotectWorksheet = True
Exit Function
ErrHandler:
UnprotectWorksheet = False
End Function
</source>

==Protect Sheet==



<source lang="vb">

Sub ProtectSheet()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Protection")
ws.Protect "Excel2003", , True, , True
ws.Range("A1").Value = 42
Debug.Print ws.ProtectContents
Debug.Print ws.ProtectDrawingObjects
Debug.Print ws.ProtectionMode
Debug.Print ws.ProtectScenarios
End Sub
</source>

==remove user==



<source lang="vb">

Sub RemoveUser()
Dim ws As Worksheet, rng As Range, aer As AllowEditRange
Set ws = ThisWorkbook.Sheets("Protection")
ws.Unprotect
Set aer = ws.Protection.AllowEditRanges("User Range")
aer.Users("Power Users").Delete
End Sub
</source>

==Remove user edit range==



<source lang="vb">

Sub RemoveUserEditRange()
Dim ws As Worksheet, rng As Range, aer As AllowEditRange
Set ws = ThisWorkbook.Sheets("Protection")
ws.Unprotect
For Each aer In ws.Protection.AllowEditRanges
aer.Delete
Next
End Sub
</source>

==Show Protection Properties==



<source lang="vb">

Sub ShowProtectionProperties()
Dim ws As Worksheet, prot As Protection
Set ws = ThisWorkbook.Sheets("Protection")
Set prot = ws.Protection
Debug.Print prot.AllowDeletingColumns
Debug.Print prot.AllowDeletingRows
Debug.Print prot.AllowFiltering
Debug.Print prot.AllowSorting
Debug.Print prot.AllowUsingPivotTables
Debug.Print prot.AllowFormattingCells
Debug.Print prot.AllowFormattingColumns
Debug.Print prot.AllowFormattingRows
Debug.Print prot.AllowInsertingColumns
Debug.Print prot.AllowInsertingRows
Debug.Print prot.AllowInsertingHyperlinks
End Sub
</source>

==Unprotect worksheet==



<source lang="vb">

Sub UnprotectWS()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Protection")
ws.Unprotect "Excel2003"
End Sub
</source>

← Предыдущая	Версия 16:33, 26 мая 2010
(нет различий)

VBA/Excel/Access/Word/Excel/Worksheet Protection - История изменений

в 16:33, 26 мая 2010

Admin: 1 версия