VBA/Excel/Access/Word/Access/User Access

Материал из VB Эксперт
Перейти к: навигация, поиск

Add Edit Range

   <source lang="vb">

Sub AddEditRange()

   Dim ws As Worksheet, ual As UserAccessList, aer As AllowEditRange, usr As UserAccess
   Set ws = ThisWorkbook.Sheets("Protection")
   ws.Unprotect "Excel2003"
   Set aer = ws.Protection.AllowEditRanges.Add("Edit Range", ws.[a1:c4], "pass1")
   Set usr = aer.Users.Add("Power Users", True)
   ws.Protect "Excel2003"

End Sub

</source>
   
  


Build user list

   <source lang="vb">

Sub BuildUserList()

   Dim ws As Worksheet, ual As UserAccessList, aer As AllowEditRange, _
     usr As UserAccess
   Set ws = ThisWorkbook.Sheets("Protection")
   ws.Unprotect "Excel2003"
   Set aer = ws.Protection.AllowEditRanges("Edit Range")
   Set ual = aer.Users
   Set usr = ual.Add("Administrators", True)
   Set usr = ual.Add("Users", True)
   Set usr = ual.Add("Guests", False)
   For i = 1 To ual.Count
       Set usr = ual(i)
       Debug.Print usr.Name
   Next
   ws.Protect "Excel2003"

End Sub

</source>
   
  


Delete user list

   <source lang="vb">

Sub DeleteUserList()

   Dim ws As Worksheet, ual As UserAccessList, aer As AllowEditRange, _
     usr As UserAccess
   Set ws = ThisWorkbook.Sheets("Protection")
   ws.Unprotect "Excel2003"
   Set aer = ws.Protection.AllowEditRanges("Edit Range")
   Set ual = aer.Users
   ual.DeleteAll
   ws.Protect "Excel2003"

End Sub

</source>
   
  


Remove Edit Ranges

   <source lang="vb">

Sub RemoveEditRanges()

   Dim ws As Worksheet, ual As UserAccessList, aer As AllowEditRange
   Set ws = ThisWorkbook.Sheets("Protection")
   ws.Unprotect "Excel2003"
   For Each aer In ws.Protection.AllowEditRanges
       aer.Delete
   Next
   ws.Protect "Excel2003"

End Sub

</source>
   
  


Show Edit Ranges

   <source lang="vb">

Sub ShowEditRanges()

   Dim ws As Worksheet, ual As UserAccessList, aer As AllowEditRange
   Set ws = ThisWorkbook.Sheets("Protection")
   For Each aer In ws.Protection.AllowEditRanges
       Debug.Print aer.Title, aer.Range.Address
   Next

End Sub

</source>
   
  


Unlock Edit Range

   <source lang="vb">

Sub UnlockEditRange()

   Dim ws As Worksheet, ual As UserAccessList, aer As AllowEditRange
   Set ws = ThisWorkbook.Sheets("Protection")
   For Each aer In ws.Protection.AllowEditRanges
       aer.Unprotect
   Next

End Sub

</source>