Excelマクロパスワードを入力して、全シート一括保護解除したい。

Question

いつもお世話になります。現在、下記のマクロを使っていますが、これだとpwが7で固定されてしまいます。pwの部分を毎回書き換えて使ってもいいのですが、マクロ実行と共にpwを打ち込むように変更したいです。InputBoxを入れるとうまくいきそうだと思い、作業してみたのですが上手くいきません。同ファイル内のすべてのシートは同じpwになっています。


Sub 全シート一括保護解除()
    Dim s As Worksheet
    For Each s In ActiveWorkbook.Sheets
        s.Unprotect Password:="7"
    Next s
End Sub

初心者なりにイメージは出来るのですが、出来そうで出来ないですね。
ご教示よろしくお願いいたします。

Qchan1962 · Accepted Answer

すみません。＃３はパスワード無シートの保護を解除できないので下記のように修正しました。 InputBoxで何も入力せずOKを押した場合、パスワード無のシートのみが対象になります。 Sub 全シート一括保護解除() Dim s As Worksheet Dim ps As String, erMsg As String ps = InputBox("パスワードを使用しない場合はそのままOKを押して下さい", "パスワードを入力してください") If StrPtr(ps) = 0 Then MsgBox ("キャンセルしました"): Exit Sub For Each s In ActiveWorkbook.Sheets On Error Resume Next If s.ProtectContents = True Then If ps <> "" Then s.Unprotect Password:="" If Err.Number = 0 Then erMsg = erMsg & vbCrLf & s.Name s.Protect GoTo skp End If End If s.Unprotect Password:=ps If Err.Number <> 0 Then erMsg = erMsg & vbCrLf & s.Name End If skp: On Error GoTo 0 Next s If erMsg <> "" Then MsgBox ("パスワードが違うため解除出来ないシートがあります。" & vbCrLf & erMsg) End Sub バージョンによって挙動が変わるようなので、べたになり、だんだんコードが増えて判り難くなってしまいますね。

Qchan1962 · Answer

＞pwが正しくないシートは無視して、次のシートに進むようにはできないのでしょうか。

パスワードのない保護シートを解除してよい場合は、＃２のもので大丈夫かと思います。
もし、パスワード無し保護シートを解除しない場合は、少し複雑になりますが、下記のような感じで行けるかと思います。

なお、最後に出るメッセージが要らない場合は、
If erMsg <> "" Then MsgBox ("パスワードが違うため解除出来ないシートがあります。" & vbCrLf & erMsg)
をコメントアウトもしくは消してください。

Sub 全シート一括保護解除()
Dim s As Worksheet
Dim ps As String, erMsg As String
ps = InputBox("パスワードを使用しない場合はそのままOKを押して下さい", "パスワードを入力してください")
If StrPtr(ps) = 0 Then MsgBox ("キャンセルしました"): Exit Sub
For Each s In ActiveWorkbook.Sheets
On Error Resume Next
If s.ProtectContents = True Then
s.Unprotect Password:=""
If Err.Number = 0 Then
erMsg = erMsg & vbCrLf & s.Name
s.Protect
GoTo skp
End If
s.Unprotect Password:=ps
If Err.Number <> 0 Then erMsg = erMsg & vbCrLf & s.Name
End If
skp:
On Error GoTo 0
Next s
If erMsg <> "" Then MsgBox ("パスワードが違うため解除出来ないシートがあります。" & vbCrLf & erMsg)
End Sub

Qchan1962 · Answer

こんにちは＞、pwがあっていたシートの保護は解除されて、そうでないものはそのままということで間違いなかったでしょうか。パスワードが違うため解除できないと出ますが、パスワードがあっていたシートは解除できていたように思います。なるほどですね。示したコードの場合、その結果は、たまたまである可能性が高いです。ブックにあるシートを順次処理していくので初めのシートでエラーが発生した場合、処理をやめて（抜けて）しまい実行されないのでなにもされません。逆に最後のシートでエラーが出た場合は、それまでのシートは処理されているので最後のシートだけ処理されません。確かにそのあたりの処理コードは入れていませんでしたね。おっしゃる通り、パスワードが合っていないシートは処理をせず、合っているシートをすべて処理する為には、下記のようにします。 Sub 全シート一括保護解除() Dim s As Worksheet Dim ps As String, erMsg As String ps = InputBox("パスワードを使用しない場合はそのままOKを押して下さい", "パスワードを入力してください") If StrPtr(ps) = 0 Then MsgBox ("キャンセルしました"): Exit Sub For Each s In ActiveWorkbook.Sheets On Error Resume Next If s.ProtectContents = True Then s.Unprotect Password:=ps If Err.Number <> 0 Then erMsg = erMsg & vbCrLf & s.Name On Error GoTo 0 End If Next s If erMsg <> "" Then MsgBox ("パスワードが違うため解除出来ないシートがあります。" & vbCrLf & erMsg) End Sub 注意：パスワードを掛けていない保護シートも解除されてしまいます。＞ここまでマクロが複雑になると私にはかなり難しいです。勉強の為に1行1行理解するようにしていますが時間もかなりかかります。（時間）機会がないと中々検証して確認していくのは、大変ですね。 1行1行理解する事は大事ですね。タイミングが合い、お力になれる範囲であれば、回答させて頂きますので気になさらずに、気軽にご質問をしてください。

Qchan1962 · Answer

こんばんは、
同様のご質問を繰り返しているようですね。
分からなくなると言う事でエラー対策はしていません。
いわゆる、実行コードは下記で良いと思います。

Sub 全シート一括保護解除()
Dim s As Worksheet
Dim ps As String
ps = InputBox("パスワードを使用しない場合はそのままOKを押して下さい", "パスワードを入力してください")
　 For Each s In ActiveWorkbook.Sheets
　　  s.Unprotect Password:=ps
　 Next s
End Sub

ご質問の場合、上記だけで良いと思いますが、

補足と余談として
上記の場合、InputBoxは、OKを押すと正常に機能しますが、
キャンセルボタンを押した場合、パスワードなしで保護の解除を実行してしまいます。なので、InputBoxのボタンの条件で対策が必要になります。
OKボタン、キャンセルボタン、×ボタン

また、Unprotect処理も間違ったパスワードで実行した場合、エラーになります。　したがって、前出のコードや説明にある一見関係なさそうなエラー対策のコードが必要になるのです。

最低限のエラー処理を加えると

Sub 全シート一括保護解除()
Dim s As Worksheet
Dim ps As String
    ps = InputBox("パスワードを使用しない場合はそのままOKを押して下さい", "パスワードを入力してください")
    If StrPtr(ps) = 0 Then MsgBox ("キャンセルしました"): Exit Sub
    For Each s In ActiveWorkbook.Sheets
        If s.ProtectContents = True Then
            On Error GoTo myErr
            s.Unprotect Password:=ps
        End If
    Next s
    Exit Sub
myErr:     MsgBox ("パスワードが違うため解除できません!")
End Sub

また、複数のシートの場合、無いと言い切れるのかも知れませんが、
5シート中、2シートのみ保護がある場合などの対策も必要になると思われます。
処理を正しく行う為には、コードが複雑になって見えるのだと思います。

この辺りは、解りますでしょうか？

もう一つ、ご質問にはないのですが、毎回このコードを対象のExcelブックを開き、VBEを開きコピペして実行するのでしょうか？　ファイルによってパスワードが違うと言う情報で想像しています。

マナー違反かも知れませんが、前に回答した
https://oshiete.goo.ne.jp/qa/12265456.html
コードに不備がありましたので
下記に修正、追加したしたコードを投稿いたします。

新規ブックに標準モジュールを作成してすべてを同じモジュールにコピペで使用できると思います。
このVBAは自身のブックを操作することは出来ませんが、閉じている対象のブックを選んで処理します。
従ってVBAのコピペは処理の度に行う必要がありません。
スタートプロシージャは、Sub Sample1()　です。
長文で申し訳ないです。
今回も一応、分からないところなどありましたら締め切らず補足などをしてください。

Option Explicit
Dim myMsg(1) As String
Sub Sample1()
Dim Target As String
Dim CHECK_Protect As Integer
Dim flag As Boolean
Dim ws As Worksheet
Dim myKey As String
Dim rc As Variant
　 Target = Application.GetOpenFilename _
　　　　 (Title:="シート保護設定ファイルの選択してください。", FileFilter:="Excel ブック,*.xls?")
　 If Target = "False" Then
　　  MsgBox ("キャンセルしました")
　　  Exit Sub
　 End If
　 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
　　  Call make_message(flag)
　　  If CHECK_Protect > 0 And CHECK_Protect < .Worksheets.Count Then
　　　　rc = MsgBox("保護されているシートのみ解除する場合は、[OK]を押して下さい", _
　　　　　　　　vbOKCancel + vbExclamation, "一部のシートが保護されています")
　　　　If rc = vbOK Then
　　　　　 Call make_message(True)
　　　　　 Call myProtect(myKey, True)
　　　　　 If myKey = "Err1" Then GoTo myEnd
　　　　　 If myKey = "Err2" Then GoTo myErr
　　　　　 MsgBox (myMsg(1))
　　　　Else
　　　　　 MsgBox ("キャンセルしました")
　　　　　 GoTo myEnd
　　　　End If
　　  Else
　　　　Call myProtect(myKey, flag)
　　　　If myKey = "Err1" Then GoTo myEnd
　　　　If myKey = "Err2" Then GoTo myErr
　　　　MsgBox (myMsg(1))
　　  End If
　　  GoTo myEnd
myErr:
　　  MsgBox ("パスワードが違うため解除できません!")
myEnd:
　　  .Close SaveChanges:=True
　　  Application.ScreenUpdating = True
　 End With
End Sub

Sub myProtect(myKey As String, flag As Boolean)
Dim Pas As String
Dim ws As Worksheet
　 Pas = InputBox _
　　　 ("パスワードを入力してください" & vbCrLf & vbCrLf & _
　　　  "パスワードを使用しない場合はそのままOKを押して下さい", myMsg(0))
　 If StrPtr(Pas) = 0 Then MsgBox ("処理を中止します"): GoTo myErr1
　 For Each ws In ActiveWorkbook.Worksheets
　　  On Error GoTo myErr2
　　  If ws.ProtectContents = True Then
　　　　ws.Unprotect Password:=Pas
　　  Else
　　　　If flag = False Then ws.Protect Password:=Pas
　　  End If
　 Next
　 Exit Sub
myErr1:
　 myKey = "Err1"
　 Exit Sub
myErr2:
　 myKey = "Err2"
End Sub

Sub make_message(flag As Boolean)
　 If flag = False Then
　　  myMsg(0) = "全シートの保護を設定します"
　　  myMsg(1) = "シート保護を設定しました"
　 Else
　　  myMsg(0) = "全シートの保護を解除します"
　　  myMsg(1) = "シート保護を解除しました"
　 End If
End Sub

Excelマクロ パスワードを入力して、全シート一括保護解除したい。

すみません。

＞pwが正しくないシートは無視して、次のシートに進むようにはできないのでしょうか。

こんにちは

こんばんは、

似たような質問が見つかりました

このQ&Aを見た人はこんなQ&Aも見ています

関連するカテゴリからQ&Aを探す

このQ&Aを見た人がよく見るQ&A

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング

Excelマクロパスワードを入力して、全シート一括保護解除したい。