Как ссылаться на несколько листов в выписках

Question

Цель и проблема

Моя цель - ограничить доступ к различным рабочим листам в соответствии с именем пользователя, которое в настоящее время использует файл Excel.

У меня будет минимум 14 пользователей (1 администратор и 13 начальников отделов), и у каждого будет разный доступ к нескольким рабочим листам. Администратор будет иметь доступ ко всем рабочим листам, в то время как главы департаментов будут иметь доступ к рабочему листу, связанному только с их отделом, и как минимум к 2 или 3 другим рабочим листам.

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

Что я пробовал

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

    Select Case Application.UserName        
        Case "User 2"
            Set GetAllowedSheet = Sheets(Array("Sheet2", "Sheet3", "Sheet4"))

Dim ArrayOne as Variant
ArrayOne = Array("Sheet2", "Sheet3", "Sheet4")

    Select Case Application.UserName        
        Case "User 2"
            Set GetAllowedSheet = Sheets(ArrayOne)

Я провел небольшое исследование в Google, но, похоже, ничего не соответствует тому, что я ищу.

Код

Private Sub Workbook_Open()
    Showorksheets
End Sub

Sub Showorksheets()

    Dim ws As Worksheet
    Dim wsAllowed As Worksheet

    If Application.UserName = "User 0" Then
        For Each ws In Worksheets
            ws.Visible = xlSheetVisible
        Next
        Exit Sub
    End If

    Set wsAllowed = GetAllowedSheet
    wsAllowed.Visible = xlSheetVisible

    For Each ws In Worksheets
        If ws.Name <> wsAllowed.Name Then
            ws.Visible = xlSheetHidden
        End If
    Next

End Sub

Function GetAllowedSheet() As Worksheet

    Select Case Application.UserName
        Case "User 1"
            Set GetAllowedSheet = Sheets("Sheet1")
        Case "User 2"
            Set GetAllowedSheet = Sheets("Sheet2")
        Case "User 3"
            Set GetAllowedSheet = Sheets("Sheet3")
        '...
        Case Else
        '...

    End Select

End Function

Answer 1

Из-за того, как вы настроили свой выбор в качестве функции, трудно изменить его на то, что вам нужно, но не невозможно. Вы находитесь на правильном пути с использованием массива. Вот примерное значение того, во что вам нужно будет переработать ваш код:

Sub Shosheets()
Dim ws As Worksheet
Dim i As Long
Dim allowed As Variant

allowed = getallowed

Sheets(Sheets.Count).Visible = xlSheetVisible

For Each ws In ThisWorkbook.Sheets
    For i = 0 To UBound(allowed)
        If allowed(i) = ws.Name Then
            If ws.Visible = xlSheetHidden Then ws.Visible = xlSheetVisible
            GoTo Nextloop
            Else
                If ws.Visible = xlSheetVisible Then ws.Visible = xlSheetHidden
        End If
    Next i
Nextloop:
Next ws
End Sub

Function getallowed() As Variant
Dim blah As Long

blah = 3

Select Case blah
    Case 1
    getallowed = Array("Sheet1")
    Case 2
    getallowed = Array("Sheet2", "Sheet3")
    Case 3
    getallowed = Array("Sheet2", "Sheet3", "Sheet5")
End Select
End Function

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

Затем он будет выполнять итерацию по всем рабочим листам, по всему массиву и совпадать с тем, присутствует ли имя вашего рабочего листа в массиве. Если это так, разверните лист и go до следующей итерации листа, если нет, по умолчанию скрытие листа.

Обратите внимание, что это приведет к ошибке, если вы откроете последний видимый лист, поэтому, чтобы предотвратить это, последний лист будет невидимым в начале и скрытым, как и в случае необходимости, последним. Это предотвращает скрытие любого листа, являющегося последним, и выдает ошибку.

Кроме того, если вы не пропустите следующую итерацию при попадании в разрешенный массив, следующая итерация будет не соответствовать и будет скрывать только что невидимый лист, следовательно, Goto.Nextloop

Answer 2

Как подсказывает @BigBen, скрывать / скрывать - не лучший способ, потому что его легко обойти.

Кроме того, я не знаю, есть ли в этой книге другие макросы, которые влияют на рабочие листы, но работа со скрытыми таблицами, в то время как кодирование может быть головной болью.

Но в любом случае что-то подобное может помочь.

Private Sub Workbook_Open()
'A workbook must have always at least 1 visible worksheet
Application.ScreenUpdating = False


Dim DictWK As Object
Dim UserLevel As Byte
Dim wk As Worksheet

Set DictWK = CreateObject("Scripting.Dictionary")

With ThisWorkbook
    DictWK.Add .Worksheets("ONLY ADMIN").Name, 0 '0 because only admin can have it
    DictWK.Add .Worksheets("ADMIN AND HEADERS").Name, 1
    DictWK.Add .Worksheets("ASSISTANTS").Name, 2
    DictWK.Add .Worksheets("EVERYBODY").Name, 99 'A workbook must have at least 1 visible worksheet, so make sure there is 1 always visible to everybody
End With

UserLevel = LVL_ACCESS("User 1") 'change this to however you detect the username

For Each wk In ThisWorkbook.Worksheets
    If UserLevel <= DictWK(wk.Name) Then
        wk.Visible = xlSheetVisible
    Else
        wk.Visible = xlSheetHidden
    End If
Next wk

DictWK.RemoveAll
Set DictWK = Nothing
Application.ScreenUpdating = True
End Sub

Уровень пользователя:

Function LVL_ACCESS(ByVal vUsername As String) As Byte
Select Case vUsername
    Case "User 1"
        LVL_ACCESS = 0
    Case "User 2"
        LVL_ACCESS = 1
    Case "User 3"
        LVL_ACCESS = 2
    Case Else
        'not recognized, no access
        LVL_ACCESS = 99
End Select
End Function

Загрузил образец в Гдрайв: https://drive.google.com/open?id=1mI3LQd8QxLDlMl1bzz5hCFIwdOFCS2Nc