ＶＢＡ 特定のユーザーのみパスワードなしで開く

いつもお世話になっております。
特定のユーザーのみパスワードなしで開くことは
可能でしょうか。
特定以外の方は、パスワード入力するというこですが
わかる方おしえてくれませんでしょうか

No.6 ベストアンサー 回答者： ggrksdqn 回答日時： 2020/12/06 13:03

<手順>

1. 特定ユーザーのユーザー名を調べる

標準モジュールの下の箇所を変更
Public Const SU As String = "佐藤,鈴木,高橋"

2.パスワードを決める

標準モジュールの下の箇所を変更
Public Const PW As String = "1234"

3. シートを追加し、"ログイン"と名前を付ける
4. [校閲]-[ブックの保護]でブックを保護し、2で決めたパスワードを設定する

＜マクロの説明＞
1. ブックを開くと、PCのログイン情報を元に特定ユーザーかどうかを判定
2. 一般ユーザーならパスワードの入力を要求

　（パスワードが正しい場合）
　パスワードを使ってブックの保護を解除し、全てのシートを表示する

　（パスワードが間違っている場合）
　ブックを閉じる

3. ブックを閉じるとき、"ログイン"シートがなければ追加する
4. ”ログイン”シート以外のシートを非表示にする
5. パスワードを使って、ブックを保護する
6. 閉じる

'*********************************
'ThisWorkbookモジュール
'*********************************
Private Sub Workbook_Open()
login
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
lockWB
End Sub

'*********************************
'標準モジュール
'*********************************
Public Const PW As String = "1234"
Public Const SU As String = "佐藤,鈴木,高橋"

'ログイン
Public Sub login()

Dim usr As String
usr = CreateObject("WScript.Network").UserName

'特定のユーザーなら、ブックのロックを解除
If InStr(1, SU, usr) > 1 Then unlockWB: Exit Sub

'一般ユーザーならパスワード要求
'パスワードが間違ってれば閉じる
If InputBox("パスワードを入力") <> PW Then
MsgBox "パスワードが違います"
ThisWorkbook.Close
Else
'パスワードが正しいければブックのロックを解除
unlockWB

End If

End Sub
'ブックのロックを解除
Public Sub unlockWB()

'ブックのロックを解除
ThisWorkbook.Unprotect PW

'シートの非表示を解除
Dim s As Worksheet
For Each s In Worksheets
s.Visible = True
Next

End Sub
'ブックをロック
Public Sub lockWB()

'ログインシートがあるがどうかチェック
Dim s As Worksheet, flag As Boolean
For Each s In Worksheets
If s.Name = "ログイン" Then
flag = True
Exit For
End If
Next

'ログインシートがなければ追加
If flag = False Then
ThisWorkbook.Sheets.Add
ActiveSheet.Name = "ログイン"
End If

'シートを非表示にする
For Each s In Worksheets
If s.Name <> "ログイン" Then
s.Visible = False
End If
Next

ThisWorkbook.Protect PW
End Sub

この回答へのお礼

ありがとうございます。

お礼日時：2020/12/06 19:27

No.7 回答者： ggrksdqn 回答日時： 2020/12/06 13:10

No.6 です。

一行間違えてました。
訂正します

＜訂正前＞
'特定のユーザーなら、ブックのロックを解除
If InStr(1, SU, usr) > 1 Then unlockWB: Exit Sub

＜訂正後＞
'特定のユーザーなら、ブックのロックを解除
If InStr(1, SU, usr) > 0 Then unlockWB: Exit Sub

この回答へのお礼

ありがとうございます。

お礼日時：2020/12/06 19:27

No.5 回答者： ppp2122 回答日時： 2020/12/06 12:29

よく読んでなかった

特定以外の人間はパスワード　というのなら
Closeのところで
パスワード入力用のユーザーフォームを
立ち上げればよいでしょう

この回答へのお礼

ありがとうございます。

お礼日時：2020/12/06 19:27

No.4 回答者： ppp2122 回答日時： 2020/12/06 11:42

最後にもうひとつ

対象ブック（.xlsm）が
マクロを実行しないで開かれた場合には
この仕掛けは意味がないので、
全シートを非表示にし　保護をかけておくことを
忘れてはいけません

この回答へのお礼

ありがとうございます。

お礼日時：2020/12/06 19:27

No.3 回答者： ppp2122 回答日時： 2020/12/06 11:31

追伸

キー設定用のものは　
単独のブックで作成し
先に対象者へ配布しておきます

この回答へのお礼

ありがとうございます。

お礼日時：2020/12/06 19:27

No.2 回答者： ppp2122 回答日時： 2020/12/06 11:29

過去に作ったもの

ファイルの拡張子は　テキトーでOK
この時は「key.dcb」とした


Sub キーファイルの設定()
Dim Path As String, WSH As Variant
Dim FSO As Object

Set WSH = CreateObject("WScript.Shell")
Set FSO = CreateObject("Scripting.FileSystemObject")
Path = WSH.SpecialFolders("SendTo")

If Path <> "" Then

FSO.CopyFile ThisWorkbook.Path & "\key.dcb", Path & "\e_key.dcb"

MsgBox "キーの設定が完了しました Windws Vista"

End If

Set WSH = Nothing
Set FSO = Nothing

End Sub


Private Sub Workbook_Open()
Dim Path As String, WSH As Variant
Dim FSO As Object
Set WSH = CreateObject("WScript.Shell")
Set FSO = CreateObject("Scripting.FileSystemObject")

Path = WSH.SpecialFolders("SendTo")

If Dir(Path & "\e_key.dcb") = "" Then

MsgBox "キーが設定されていません　キーを正しく設定してください"

ThisWorkbook.Close

End If
End sub

この回答へのお礼

ありがとうございます。

お礼日時：2020/12/06 19:26

No.1 回答者： ppp2122 回答日時： 2020/12/06 11:22

不可能ではありません

”キー”となるものをあらかじめ所定の場所に配置し
WorkbookOpenイベントで　それがあるか無いかを
判断し　無ければCloseという事であれば可能。
自分が過去に作ったものは
まず　なんちゃってインストーラーを
作成します（VBAで作成）
Windowsフォルダの任意の場所に任意の名前のテキストファイルを
作成させます

その状態で　上記を実行させればOkなのです
なんちゃってインストーラーが必要な理由は
ブックを渡した人間もその仕掛けがわからないようにするためです

この回答へのお礼

ありがとうございます。

お礼日時：2020/12/06 19:26