ブックを開くための複数のパスワード（失敗談）

先日、このような相談を受けた。

1. あるExcel のブックを、複数のパスワードで管理したい。
2. このブックを開けるのは、特定の部門に所属する人だけ。
3. 各自がこのブックを開く際は、自身の社員コードをパスワードとしたい。

私の理解では、Excel のパスワードは一つのブックに一つだけ設定可能だが、さてどうしたものか。

結局、完璧ではないものの、以下を提案した。

1. まず、社員コードと氏名の一覧表を作成する。
2. ブックを開いた際、社員コードを入力させる。
3. このとき、ブックは最小化されている。
4. 入力した社員コードが一覧表に不在の場合、即終了。

「完璧ではない」としたのは、本来のパスワード同様、他の人に知られたら意味がなくなるから。しかも今回は、部門所属者の数だけ鍵がある。

それでもなお、念のため全てのシートは閉じる際に非表示にしておいた。そして、入力した社員コードが一覧表にある場合のみ、シートは表示状態となる。

標準モジュール

コードにすると、こんな感じだ。
まず、閉じるときはシートを一つ残して全て非表示にする。
一つ残したのは、全て非表示にしようとするとエラーになるから。
今回は、「☆ポータル」というシートを残すことにした。

Sub Auto_Close()
    Dim Ws As Worksheet
        For Each Ws In Worksheets
            If Ws.Name <> "☆ポータル" Then
                Ws.Visible = False
            End If
        Next
End Sub

次いで、開くときの処理を作成する。
社員コードの一覧表は、Sheet1（☆ポータルではない）に作成されている。

Sub Auto_Open()
    Dim PersonTable As ListObject
    Set PersonTable = Sheet1.ListObjects(1)
    
    Dim PersonDict As Dictionary
    Set PersonDict = New Dictionary
    Dim r As Range
        For Each r In PersonTable.ListColumns("社員コード").DataBodyRange
            PersonDict(r.Value) = r.Offset(, 1).Value
        Next
                                     
        ActiveWindow.WindowState = xlMinimized
    
    Dim EmployeeNumber As Long
        EmployeeNumber = Application.InputBox("社員番号を入力してください。", _
                                            "社員番号入力", , , , , , 1)
        
        If PersonDict.Exists(EmployeeNumber) Then
            ActiveWindow.WindowState = xlMaximized
            ThisWorkbook.Activate
            Dim Ws As Worksheet
            For Each Ws In Worksheets
                Ws.Visible = True
            Next
            
        Else
            MsgBox "社員コードが登録されていないか、または入力ミスの恐れがあるため、" & vbNewLine & _
                   "このファイルを開くことができません。"
            ThisWorkbook.Close False
        End If
End Sub

何度か、ブックを開いたり閉じたりしてみる。どうやら、期待通りの動きをしてくれるようだ。早速、依頼者に報告だ。
「ありがとうございます！・・・あれ？」
「どうしました？」
「開くときに、マクロを有効にするかどうか訊かれるんですけど？」
「あ・・・」
何という失態。そりゃそうだ。マクロが有効な環境で初めて、この仕掛けは有効になる。

という訳で、今回は敢え無く失敗したのでした（＞＜）

参考まで。