Excel 允许用户使用 VBA 编辑范围

Question

是否可以使用 vba 指定可以在没有密码的情况下编辑范围的用户？

我正在考虑使用权限表，其中包含 A 列中的用户名列表和第 1 行中的范围。在用户名和范围的交叉点处，Y 表示权限。然后通过 vba 将相应地修改允许用户编辑范围，以允许用户在没有密码的情况下编辑范围。如果交叉点有 N，则用户名将从用户列表中删除，这些用户可以在没有密码的情况下编辑范围，而不仅仅是将其权限更改为拒绝

谢谢

Answer 1

我被你的想法迷住了。因此我想出的解决方案有点复杂。它假定您只想将访问权限分配给一个工作表。如果有几个扩展是需要的。将此代码粘贴到要对其执行操作的工作表的代码表中。

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    ' 25 Jan 2018

    Dim Deny As Long
    Dim Msg As String

    On Error Resume Next
    Deny = Target.Cells.Count
    If Err Or Deny > 1 Then
        Msg = "Please edit only one cell at a time."
    End If

    ' cells which are unlocked may be modified by anyone
    If (Deny = 1) And (Target.Locked = True) Then
        If DenyAccess(Target) Then
            Msg = "You are not permitted to modify this cell."
        End If
    End If

    If Len(Msg) Then
        MsgBox Msg & vbCr & _
               "The change you made will be reversed.", _
               vbInformation, "Invalid modification"
        With Application
            .EnableEvents = False
            .Undo
            .EnableEvents = True
        End With
    End If
End Sub

其余代码应位于普通代码模块中。它不存在。您将不得不创建它。默认名称为Module1。重命名以适合您的喜好。

Option Explicit

    Dim MyPass As Range

Function DenyAccess(Target As Range) As Boolean
    ' 25 Jan 2018

    ' restart Excel after making changes to the Permissions
    If MyPass Is Nothing Then                   ' use existing if already loaded
        Set MyPass = GetPermissions
        If MyPass Is Nothing Then Exit Function ' no permissions found
    End If
    DenyAccess = (Application.Intersect(Target, MyPass) Is Nothing)
End Function

Private Function GetPermissions() As Variant
    ' 25 Jan 2018
    ' returns a range object
    ' return Nothing if no valid permissions were found

    Dim Fun() As Range
    Dim Ws As Worksheet
    Dim Arr As Variant
    Dim C As Long
    Dim i As Long

    Set Ws = Worksheets("Permissions")              ' sheet for which acces is to be granted
    Arr = UserDataRange
    If VarType(Arr) = 8204 Then
        ReDim Fun(UBound(Arr, 2))
        For C = 2 To UBound(Arr, 2)
            On Error Resume Next
            Set Fun(i) = Ws.Range(Arr(1, C))
            If Err = 0 Then i = i + 1
        Next C

        If Not Fun(0) Is Nothing Then
            ReDim Preserve Fun(i - 1)

            For C = 1 To UBound(Fun)
                Set Fun(0) = Application.Union(Fun(0), Fun(C))
            Next C
        End If
        Set GetPermissions = Fun(0)
    Else
        Set GetPermissions = Nothing
    End If
End Function

Private Function UserDataRange() As Variant
    ' 25 Jan 2018
    ' returns an array lifted from the worksheet

    Dim Ws As Worksheet
    Dim R As Long

    Set Ws = Worksheets("Permissions")              ' sheet where the permissions are
                                                    ' User names in column A
    With Application
        On Error Resume Next
        R = .Match(.UserName, Ws.Range("A:A"), 0)
    End With
    On Error GoTo 0

    If R Then
        With Ws
            UserDataRange = Range(.Cells(R, 1), .Cells(R, .Columns.Count).End(xlToLeft)).Value
        End With
    End If
End Function

现在您需要创建一个具有权限的工作表。没有 Y 和 N，正如您自己建议的那样，只有 A 列中的用户名和以下列中的范围，如“A1”、“B2:C3”、“F2”等，一个单元格中的一个范围（没有逗号）。请务必按照每个用户计算机中存储的用户名准确写入用户名。该代码不会原谅空格（正如我发现的那样），我认为它甚至可能区分大小写（您可能想知道，哈哈：）。如果您在工作簿中有此工作表，请将其设为 xlVeryHidden 并使用密码保护 VBA 项目。 （不安全但更困难。）

最后一步是准备工作表以供操作。由Permissions 控制的单元格必须被锁定。默认情况下，任何被锁定且不允许的单元格都将被拒绝访问。如果单元格已解锁，任何人都可以进行修改。

请注意，权限在首次使用时是只读的，然后存储在内存中。 （这是全局变量MyPass 的任务。如果您修改了权限，新设置将在您重新启动 Excel 后才会生效。这样做是为了加快速度：VBA 不能每次修改都检查权限工作表。

我希望它能按设计工作。