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不必检查每次修改的权限工作表。

我希望它能按设计工作。