Имя пользователя VBA Excel предоставляет доступ

Question

Нужна небольшая помощь, у меня есть документ Excel, который должен предоставлять доступ только определенным пользователям, у всех сотрудников есть имя пользователя, и когда они вводят любую информацию, которая появляется вместе с их записью. Я надеюсь защитить файл, чтобы только некоторые сотрудники могли иметь доступ. Пока у меня есть

Private Sub Workbook_Open()
 Dim Users As Variant
 Dim UName As String
 Dim UFind As Variant
 Users = Array("JBLOGS", "DOEJOHN", "ASmith", "JanDoe")

 UName = Environ("UserName")
 On Error Resume Next
 UFind = WorksheetFunction.Match(UName, Users, 0)
 If Err <> 0 Then
     MsgBox "You are not authorised to use this Workbook"
     ThisWorkbook.Close SaveChanges:=False
 End If
 End Sub

Это нормально, но я хотел, чтобы он был на отдельном листе, то есть в столбце "Пользователи", а затем в списке пользователей, к которому можно легко добавить.

Мне также было интересно, могут ли определенные пользователи быть ограничены определенными листами, например, Джон Доу в Африке, Джейн в Америке, могу ли я ограничить их только просмотром листов под заголовком "Африка" и "Америка"

Посмотрел и ничего не увидел, поэтому не уверен, что это легко сделать...

Answer 1

Я бы предложил создать скрытый лист для хранения вашего списка имен пользователей, при желании вы даже можете защитить скрытый лист с помощью пароля. Кроме того, вы можете расширить свой список имен пользователей до таблицы, в которой перечислены рабочие листы, которые каждый пользователь может просматривать. Любые листы, запрещенные таблицей, также могут быть скрыты от этого пользователя (и, конечно, невидимы для другого пользователя с предоставленным доступом). В качестве примечания вы можете счесть полезным проводить сравнение имен пользователей из таблицы с переменной окружения без учета регистра - это иногда приводило меня в замешательство.

EDIT1: вот пример, чтобы вы начали:

Создайте лист с именем "AuthUsers", а затем создайте таблицу с именем "UserTable". Определите два столбца в таблице: первый называется "Пользователи", а второй - "Листы".

EDIT2: добавлено ViewAuthorizedSheets метод, чтобы скрыть / просмотреть соответствующие рабочие таблицы и обновил тестовый саб. Это также работает очень хорошо, когда вызывается из Worksheet_Open,

Option Explicit

Sub test()
    Debug.Print "user is authorized = " & IsUserAuthorized(Environ("UserName"))
    ViewAuthorizedSheets Environ("UserName")
    If IsUserAuthorized(Environ("UserName")) Then
        Debug.Print "authorized sheets = " & GetAuthorizedSheets(Environ("UserName"))
    Else
        MsgBox "User is not authorized to view any sheets.", vbCritical + vbOKOnly
    End If
End Sub

Public Sub ViewAuthorizedSheets(uname As String)
    Dim authSheets As String
    Dim sh As Worksheet
    uname = Environ("UserName")
    authSheets = GetAuthorizedSheets(uname)
    For Each sh In ThisWorkbook.Sheets
        If sh.Name <> "AuthUsers" Then
            If InStr(1, authSheets, sh.Name, vbTextCompare) > 0 Then
                sh.Visible = xlSheetVisible
            Else
                sh.Visible = xlSheetHidden
            End If
        End If
    Next sh
End Sub

Function IsUserAuthorized(uname As String) As Boolean
    Dim ws As Worksheet
    Dim userTbl As ListObject
    Dim userList As Range
    Dim allowedUser As Variant
    Dim allowed As Boolean

    Set ws = ThisWorkbook.Sheets("AuthUsers")
    Set userTbl = ws.ListObjects("UserTable")
    Set userList = userTbl.ListColumns("Users").DataBodyRange
    allowed = False
    For Each allowedUser In userList
        If LCase(allowedUser) = LCase(uname) Then
            allowed = True
            Exit For
        End If
    Next allowedUser
    Set userList = Nothing
    Set userTbl = Nothing
    Set ws = Nothing
    IsUserAuthorized = allowed
End Function

Function GetAuthorizedSheets(uname As String) As String
    Dim ws As Worksheet
    Dim userTbl As ListObject
    Dim userList As Range
    Dim allowedUser As Variant
    Dim allowed As String

    Set ws = ThisWorkbook.Sheets("AuthUsers")
    Set userTbl = ws.ListObjects("UserTable")
    Set userList = userTbl.DataBodyRange
    allowed = False
    For Each allowedUser In userList.Columns(1).Cells
        If LCase(allowedUser) = LCase(uname) Then
            allowed = allowedUser.Offset(0, 1).value
            Exit For
        End If
    Next allowedUser
    Set userList = Nothing
    Set userTbl = Nothing
    Set ws = Nothing
    GetAuthorizedSheets = allowed
End Function

В вашем ThisWorkbook модуль, вызов доступен просто

Option Explicit

Private Sub Workbook_Open()
    ViewAuthorizedSheets Environ("UserName")
End Sub

Answer 2

Private Sub Workbook_Open()

    Dim EmpArray(3) As String
    Dim Count As Integer

    EmpArray(0) = "dzcoats"
    EmpArray(1) = "cspatric"
    EmpArray(2) = "eabernal"
    EmpArray(3) = "lcdotson"

    Count = 0

    For i = LBound(EmpArray) To UBound(EmpArray)
    If Application.UserName = EmpArray(i) Then Count = Count = 1
    Next i

    If Count = 0 Then
        MsgBox ("You dont have access to this file")
        ThisWorkbook.Close SaveChanges:=False
    End If

End Sub

Это должно работать. Логика моего счета неаккуратна, но она делает свое дело