Как настроить c рабочую книгу для c пользователей

Question

Я хотел бы иметь лист Excel, где я могу ввести имя пользователя, чтобы предоставить им доступ к книге Excel.

Я нашел код VBA, и он в порядке, но мне нужно иметь его на листе. Я думаю, что это более практично, чем ввод кода VBA для внесения изменений (смена пользователей или добавление пользователей).

Вот код:

Private Sub Workbook_Open()
Dim user As String
Dim users(5) As String

users(0) = "SomeUser"
users(1) = "SomeUser"
users(2) = "SomeUser"
users(3) = "SomeUser"
users(4) = "SomeUser"

user = Application.UserName

Dim access As Boolean
Dim i As Integer

access = False

For i = 0 To 4
    If users(i) = user Then
        access = True
        Exit For
    End If
Next

If access = False Then
    MsgBox ("Sorry, the user """ & "Liam" & """ does not have the correct access rights to view this workbook")
    ActiveWorkbook.Close
End If

End Sub

Answer 1

Это сделает то, что вам нужно, но есть более эффективные способы управления правами доступа в файлах Excel.

Поместите этот код в объект ThisWorkbook

Private Sub Workbook_Open()
    Dim Users As Object
    Set Users = GetUsers()

    If Not Users.Exists(Application.UserName) Then
        MsgBox "Sorry, you lack access to this workbook.", vbCritical, "No Access"
        ThisWorkbook.Close
    End If
End Sub

Поместите этот код в модуль. Предполагается, что у вас есть лист с именем Users, а имена пользователей сохраняются, начиная с ячейки A2 и заканчивая вниз.

Public Function GetUsers() As Object
    Dim Users As Range
    Dim User  As Range

    With ThisWorkbook.Sheets("Users") 'Replace Users with name, or use CodeName
        Set Users = .Range("A2:A" & .Cells(.Rows.Count, "A").End(xlUp).Row) 'Assuming header row on A1
    End With

    Set GetUsers = CreateObject("Scripting.Dictionary")

    For Each User In Users
        If Not GetUsers.Exists(User.Value2) Then GetUsers.Add User.Value2, User.Value2
    Next
End Function