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

我希望它按设计工作。

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

1 个答案: