エクセルシートのパスワード保護について

質問

十数枚のシートを持つエクセルのブックがあります。
ブックとそれぞれのシートにパスワード保護が必要です。しかし、週に1度はパスワードを解除する必要があります。これが毎週のことなので、それぞれのシートごとに解除し、また設定するのはとても時間がかかり負担です。特定の個所だけならセルのロックをはずしておけばいいのでしょうが、そうではありません。
パスワード保護を全部のシートに一度に解除したり設定する方法はないものでしょうか？
なお、エクセルのバージョンは97です。

回答No.7

taisuke555 · ベストアンサー

#2の補足です。

ちょっと現象がでなかったので、とりあえず型宣言をはずしました。
あと２回パスワードをということを他の人の補足に書いてあったので追加しました。

No.8さんの
＞パスを　3634　とした場合　1104　でも　1125　でも　1146　でも　1167　でも開けます。
初めて知りました。それではパスワードの意味が無いですね。
まあ、無いよりはいいでしょうけど・・・

Sub SheetProtect()
If (ActiveSheet.ProtectContents = False) Then
pw = InputBox("パスワードを入力してください", "シート保護")

If (pw <> "") Then
pw2 = InputBox("確認の為もう一度パスワードを入力してください", "シート保護")
If (pw = pw2) Then
For Each st In ThisWorkbook.Sheets
st.Protect password:=pw, DrawingObjects:=True, Contents:=True, Scenarios:=True
Next st
Else
MsgBox "先に入力したパスワードと一致しません"
End If
Else
MsgBox "パスワードを入力して下さい"
End If
Else
MsgBox "シートは既に保護されています"
End If
End Sub

回答No.6

papayuka

こんにちは。

> 上記の例では”123”を変数にしてみようと思いましたの
> で、誤入力防止のために質問させていただきました。

意味が解かりません。
123を変数にするとは？

提示した方法は通常のパスワード呼出しとは異なりますので、パスワードはソース内に埋め込む必要があります。
Excelの標準ダイアログでやるならシート毎に設定するしかないのでは？
SendkeyとClipboardを使ってキー入力を送るにしてもセットと解除で異なりますし。。

Sub Test()
Dim ws As Worksheet

For Each ws In Worksheets
　ws.Activate
　Application.Dialogs(xlDialogProtectDocument).Show
Next
　Application.Dialogs(xlDialogWorkbookProtect).Show

End Sub

そもそもExcelの保護なんてそれ程優れたものではないです。今のバージョンは解かりませんがExcel97だとシート又はブック保護のパスを　3634　とした場合　1104　でも　1125　でも　1146　でも　1167　でも開けます。（他にもあります）

お礼

ありがとうございました。
何とかできました。

回答No.5

papayuka

再びこんにちは。

後は運用の問題だと思いますが、、

Sub Pass_Open()
　WS_UnProtect (Application.InputBox("パスは？", "ほげ", Type:=1))
End Sub

Sub Pass_Set()
　WS_Protect (Application.InputBox("パスは？", "ほげ", Type:=1))
End Sub

Private Sub WS_Protect(Pass)
Dim ws As Worksheet
If Pass <> "123" Then Exit Sub
　For Each ws In Worksheets
　　ws.Protect "123"
　Next ws
End Sub

Private Sub WS_UnProtect(Pass)
Dim ws As Worksheet
If Pass <> "123" Then Exit Sub
　For Each ws In Worksheets
　　ws.Unprotect "123"
　Next ws
End Sub

お礼

さっそくのご回答ありがとうございます。
うまくいきました！ありがとうございます。
最後に一つだけ・・・・。
設定時のパスワード設定を通常のように2回入力させるにはどうしたらよいでしょうか？
というのは上記の例では”123”を変数にしてみようと思いましたので、誤入力防止のために質問させていただきました。なんどもすみません。

回答No.4

Enfant

＃３です 。
Bookを開いたときに保護をはずすのだから
Private Sub Workbook_Open()
に書けば良いと思ったのですが、他の人が開くときは保護を掛けたまま開かなくてはいけないことを忘れていました。

さらに、パスワードを入力ミスすることを考えに入れませんでした。
そのことを考えると、やはり標準モジュール内に置いてボタンやキーに割り付けるか、ツール-マクロ-マクロから呼び出せるようにしなくてはいけませんでした。
ということで、＃3さんの回答が完璧かと思います。

（また、Closeする時に保護を掛けるようにと考えたのですが、保護をかけるはずの
Private Sub Workbook_BeforeClose(Cancel As Boolean)
の方に保護をはずすマクロを貼り付けてしまいました。）

回答No.3

Enfant

こんばんは
＃2さんからの盗作ですが
ThisWorkBook内に

Private Sub Workbook_Open()
Dim pw As String
Dim st As Worksheet

If (ActiveSheet.ProtectContents = True) Then
pw = InputBox("パスワードを入力してください", "シート保護の解除")
If (pw <> "") Then

On Error GoTo UnprotectError
For Each st In ThisWorkbook.Sheets
st.Unprotect password:=pw
Next st
End If
Else
MsgBox "シートは保護されていません"
End If
Exit Sub
UnprotectError:
MsgBox "パスワードが違います"
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim pw As String
Dim st As Worksheet

If (ActiveSheet.ProtectContents = True) Then
pw = InputBox("パスワードを入力してください", "シート保護の解除")
If (pw <> "") Then

On Error GoTo UnprotectError
For Each st In ThisWorkbook.Sheets
st.Unprotect password:=pw
Next st
End If
Else
MsgBox "シートは保護されていません"
End If
Exit Sub
UnprotectError:
MsgBox "パスワードが違います"
End Sub

の二つを置くというのはどうでしょう。

お礼

ありがとうございました。
何とかできました。

回答No.2

taisuke555

No.1の方とほぼ同じになってしまいましたが、
[F11]:シート保護　　[F12]:シート保護解除を割り付けてあります。

ThisWorkBook内
Private Sub Workbook_Activate()
Application.OnKey "{F11}", "SheetProtect"
Application.OnKey "{F12}", "SheetUnprotect"
End Sub

Private Sub Workbook_Deactivate()
Application.OnKey "{F11}"
Application.OnKey "{F12}"
End Sub

標準モジュール内
Sub SheetProtect()
Dim pw As String
Dim st As Worksheet

If (ActiveSheet.ProtectContents = False) Then
pw = InputBox("パスワードを入力してください", "シート保護")

If (pw <> "") Then
For Each st In ThisWorkbook.Sheets
st.Protect password:=pw, DrawingObjects:=True, Contents:=True, Scenarios:=True
Next st
End If
Else
MsgBox "シートは既に保護されています"
End If
End Sub

Sub SheetUnprotect()
Dim pw As String
Dim st As Worksheet

If (ActiveSheet.ProtectContents = True) Then
pw = InputBox("パスワードを入力してください", "シート保護の解除")
If (pw <> "") Then

On Error GoTo UnprotectError
For Each st In ThisWorkbook.Sheets
st.Unprotect password:=pw
Next st
End If
Else
MsgBox "シートは保護されていません"
End If
Exit Sub
UnprotectError:
MsgBox "パスワードが違います"
End Sub

ThisWorkBook内の部分をやめて、コマンドボタンにマクロを登録してもよいと思います。
この例では、すべてのシートで同じパスワードを使用するように作ってあります。
また、シート保護のダイアログのようにパスワードを*で表示したい場合は、
自分でダイアログを作るか、API関数にあったと思います。（手元に資料がない為未確認）
一応９７で確認済みです。何か問題があれば補足してください。

参考になればと思います。

お礼

出張していたため、お返事がおそくなりもうしわけありません。
早速のご回答ありがとうございます。
試してみました。

ボタンにSub SheetProtectを登録しました。
実行すると「Next st」のところで実行時エラー13「型が一致しません」というエラーになってしまいます。

どうすればいいのでしょうか？

回答No.1

papayuka

こんにちは。

マクロです。テスト用ブックで試して下さい。
VBAProjectの保護をしておかないとパスが丸見えですが。。

Sub WS_Protect()
Dim ws As Worksheet
　For Each ws In Worksheets
　　ws.Protect "123"
　Next ws
End Sub

Sub WS_UnProtect()
Dim ws As Worksheet
　For Each ws In Worksheets
　　ws.Unprotect "123"
　Next ws
End Sub

お礼

出張していたため、お返事がおそくなりもうしわけありません。
早速のご回答ありがとうございます。
試してみました。
確かに保護も解除もできましたが、Sub WS_UnProtectを実行するとパスワードを聞かれずに保護解除となり、これではパスワードを設定する意味がなくなってしまうのですが・・・・。