ブックを開くための複数のパスワード(失敗談)
先日、このような相談を受けた。
- あるExcel のブックを、複数のパスワードで管理したい。
- このブックを開けるのは、特定の部門に所属する人だけ。
- 各自がこのブックを開く際は、自身の社員コードをパスワードとしたい。
私の理解では、Excel のパスワードは一つのブックに一つだけ設定可能だが、さてどうしたものか。
結局、完璧ではないものの、以下を提案した。
- まず、社員コードと氏名の一覧表を作成する。
- ブックを開いた際、社員コードを入力させる。
- このとき、ブックは最小化されている。
- 入力した社員コードが一覧表に不在の場合、即終了。
「完璧ではない」としたのは、本来のパスワード同様、他の人に知られたら意味がなくなるから。しかも今回は、部門所属者の数だけ鍵がある。
それでもなお、念のため全てのシートは閉じる際に非表示にしておいた。そして、入力した社員コードが一覧表にある場合のみ、シートは表示状態となる。
標準モジュール
コードにすると、こんな感じだ。
まず、閉じるときはシートを一つ残して全て非表示にする。
一つ残したのは、全て非表示にしようとするとエラーになるから。
今回は、「☆ポータル」というシートを残すことにした。
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
何度か、ブックを開いたり閉じたりしてみる。どうやら、期待通りの動きをしてくれるようだ。早速、依頼者に報告だ。
「ありがとうございます!・・・あれ?」
「どうしました?」
「開くときに、マクロを有効にするかどうか訊かれるんですけど?」
「あ・・・」
何という失態。そりゃそうだ。マクロが有効な環境で初めて、この仕掛けは有効になる。
という訳で、今回は敢え無く失敗したのでした(><)
参考まで。