Excelで同一ファイル内の複数(すべての)シートを同じパスワードで一括保護、一括保護解除するマクロ

Excelで同一ファイル内の複数(すべての)シートを同じパスワードで一括保護、一括保護解除するマクロを教えて頂きたいです。パスワードはファイルによって変わります。
以前、同様の質問をし、自分なりに解決出来たと思いましたがいざしてみると上手くいかず再度質問させて頂きます。
マクロ初心者ですので、簡単な方法でお願いします。

No.1 ベストアンサー 回答者： Qchan1962 回答日時： 2021/03/20 15:35

こんにちは、

https://oshiete.goo.ne.jp/qa/12261551.html　で回答したものです。
ユーザーフォームの使い方が分からなかったようですね。
ご質問が閉じられており、追記出来ませんでした。

標準モージュールにコピペとの事で色々なケースを想定してInputBox で
実行するようにしました。
対象のExcelブックは、すべてのシートの状態が同じである事。
（全てに保護がかかっている。または、かかっていない。）
保護パスワードがばらばらの場合の途中で処理を中止して保存してしまうので注意してください。

処理の流れ
対象ブックをUIで選択し開く
ブックのシート全ての保護の状態を調べる。
パスワードをInputBox で設定　（空白でOKならパスなし）
シート全てに処理
対象ブックを保存して閉じる

不明なところがあれば、締め切らずに補足してくださいね。

Sub Sample1()
Dim Target As String
Dim CHECK_Protect As Integer
Dim ws As Worksheet
Dim msg As String, Pas As String
Dim flag As Boolean
Target = Application.GetOpenFilename(Title:="シート保護設定ファイルの選択", FileFilter:="Excel ブック,*.xls?")
If Target = "False" Then Exit Sub
Application.ScreenUpdating = False
Workbooks.Open Target
With ActiveWorkbook
For Each ws In .Worksheets
If ws.ProtectContents = True Then
CHECK_Protect = CHECK_Protect + 1
flag = True
Else
flag = False
End If
Next
If CHECK_Protect > 0 And CHECK_Protect < .Worksheets.Count Then
MsgBox ("一部のシートが保護されています?")
Exit Sub
Else
If flag = False Then
msg = "全シートの保護を設定します"
Else
msg = "全シートの保護を解除します"
End If
Pas = InputBox _
(msg & vbCrLf & "パスワードを入力してください" _
& vbCrLf & "パスワードを使用しない場合はそのままOKを押して下さい", _
"全シートの保護")
If StrPtr(Pas) = 0 Then
MsgBox ("処理を中止します")
.Close SaveChanges:=True
Application.ScreenUpdating = True
Exit Sub
End If
If flag = False Then
msg = "シート保護を設定しました"
Else
msg = "シート保護を解除しました"
End If
For Each ws In .Worksheets
On Error GoTo myErr
If flag = True Then
ws.Unprotect Password:=Pas
Else
ws.Protect Password:=Pas
End If
Next
.Close SaveChanges:=True
MsgBox msg
End If
Application.ScreenUpdating = True
Exit Sub
myErr:
MsgBox ("パスワードが違うため解除できません!")
.Close SaveChanges:=True
Application.ScreenUpdating = True
End With
End Sub

この回答へのお礼

再度の丁寧な返信ありがとうございます。
無事、行うことが出来ました。
初心者ながらマクロの習得をしていますが、ここまで長くなると理解がなかなか難しいですね。
ありがとうございました。

お礼日時：2021/03/20 19:48