コピペで使えるVBA!シートを保護/保護を解除するコード

VBA

VBAマクロでシートを一括で保護したり保護を解除したりするコードを紹介します。

シートの保護はWorksheetsオブジェクトのProtectとUnprotectメソッドを使用します。

コードをコピーすればすぐに使えます。

コピペ前提なので短さを優先してコードを書きました。

誤って保護をかけてパスワードがわからなくなった場合シートの編集ができなくなるので利用は慎重にお願いします。

保護解除(パスワードを指定しない)

開いているシート

マクロ.xlsmのシート1を開いて実行

シート1 シート2 シート2
マクロ.xlsm 保護有り 保護無し 保護有り
ブック1.xlsx 保護無し 保護無し 保護無し
ブック2.xlsx 保護無し 保護無し 保護無し

実行後

シート1 シート2 シート2
マクロ.xlsm 保護無し 保護無し 保護有り
ブック1.xlsx 保護無し 保護無し 保護無し
ブック2.xlsx 保護無し 保護無し 保護無し

パスワードがある場合は終了する。


Sub 開いているシートの保護を解除する()
    On Error GoTo エラー処理
    ActiveSheet.Unprotect
    Exit Sub
エラー処理:
    MsgBox "シート「" & ActiveSheet.Name & "」の保護を解除できませんでした。" & vbCrLf & Err.Description & vbCrLf & vbCrLf & "処理を終了します。"
End Sub

開いているブックのシート全て

マクロ.xlsmのシート1を開いて実行

シート1 シート2 シート2
マクロ.xlsm 保護有り 保護無し 保護有り
ブック1.xlsx 保護無し 保護無し 保護無し
ブック2.xlsx 保護無し 保護無し 保護無し

実行後

シート1 シート2 シート2
マクロ.xlsm 保護無し 保護無し 保護無し
ブック1.xlsx 保護無し 保護無し 保護無し
ブック2.xlsx 保護無し 保護無し 保護無し

パスワードがある場合は終了する。


Sub 全てのシートの保護を解除する()
    For シートカウント = 1 To Worksheets.Count
        On Error GoTo エラー処理
        Worksheets(シートカウント).Unprotect
    Next
    Exit Sub
エラー処理:
    MsgBox "シート「" & Worksheets(シートカウント).Name & "」の保護を解除できませんでした。" & vbCrLf & Err.Description & vbCrLf & vbCrLf & "処理を終了します。"
End Sub

フォルダ内のエクセル全て

マクロ.xlsmのシート1を開いて実行

シート1 シート2 シート2
マクロ.xlsm 保護有り 保護無し 保護有り
ブック1.xlsx 保護有り 保護有り 保護有り
ブック2.xlsx 保護無し 保護無し 保護有り

実行後

シート1 シート2 シート2
マクロ.xlsm 保護有り 保護無し 保護有り
ブック1.xlsx 保護無し 保護無し 保護無し
ブック2.xlsx 保護無し 保護無し 保護無し

パスワードがある場合は終了する。


Sub 同じフォルダにある全てのブックの保護を解除する()
    Set マクロブック = ThisWorkbook
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Application.DisplayAlerts = False
    For Each ファイル In FSO.GetFolder(ThisWorkbook.Path).Files
        If ファイル.Name = マクロブック.Name Then Exit For
        If ファイル.Name Like "*.xl*" Then
            Set ターゲットブック = Workbooks.Open(ファイル.Name)
            For ターゲットシート = 1 To ターゲットブック.Worksheets.Count
                On Error GoTo エラー処理
                ターゲットブック.Worksheets(ターゲットシート).Unprotect
            Next
            ターゲットブック.Save: ターゲットブック.Close
        End If
    Next
    Application.DisplayAlerts = True
    Set FSO = Nothing
    Exit Sub
エラー処理:
    Application.DisplayAlerts = True
    Set FSO = Nothing
    MsgBox "ファイル:" & ファイル.Name & vbCrLf & "シート「" & Worksheets(ターゲットシート).Name & "」の保護を解除できませんでした。" & vbCrLf & Err.Description & vbCrLf & vbCrLf & "処理を終了します。"
End Sub

保護解除(パスワード有り)

開いているシート

マクロ.xlsmのシート1を開いて実行

シート1 シート2 シート2
マクロ.xlsm 保護有り 保護無し 保護有り
ブック1.xlsx 保護無し 保護無し 保護無し
ブック2.xlsx 保護無し 保護無し 保護無し

解除用のパスワードを入力

実行後

シート1 シート2 シート2
マクロ.xlsm 保護無し 保護無し 保護有り
ブック1.xlsx 保護無し 保護無し 保護無し
ブック2.xlsx 保護無し 保護無し 保護無し

パスワードに誤りがある場合は終了する。


Sub 開いているシートの保護を解除する、PW有り()
    パスワード = InputBox(prompt:="解除する為のパスワードを入力してください。")
    On Error GoTo エラー処理
    ActiveSheet.Unprotect パスワード
    Exit Sub
エラー処理:
    MsgBox "シート「" & ActiveSheet.Name & "」の保護を解除できませんでした。" & vbCrLf & Err.Description & vbCrLf & vbCrLf & "処理を終了します。"
End Sub

開いているブックのシート全て

マクロ.xlsmのシート1を開いて実行

シート1 シート2 シート2
マクロ.xlsm 保護有り 保護無し 保護有り
ブック1.xlsx 保護無し 保護無し 保護無し
ブック2.xlsx 保護無し 保護無し 保護無し

解除用のパスワードを入力


実行後

シート1 シート2 シート2
マクロ.xlsm 保護無し 保護無し 保護無し
ブック1.xlsx 保護無し 保護無し 保護無し
ブック2.xlsx 保護無し 保護無し 保護無し

パスワードに誤りがある場合は終了する。


Sub 全てのシートの保護を解除する、PW有り()
    パスワード = InputBox(prompt:="解除する為のパスワードを入力してください。")
    For シートカウント = 1 To Worksheets.Count
        On Error GoTo エラー処理
        Worksheets(シートカウント).Unprotect パスワード
    Next
    Exit Sub
エラー処理:
    MsgBox "シート「" & Worksheets(シートカウント).Name & "」の保護を解除できませんでした。" & vbCrLf & Err.Description & vbCrLf & vbCrLf & "処理を終了します。"
End Sub

フォルダ内のエクセル全て

マクロ.xlsmのシート1を開いて実行

シート1 シート2 シート2
マクロ.xlsm 保護有り 保護無し 保護有り
ブック1.xlsx 保護有り 保護有り 保護有り
ブック2.xlsx 保護無し 保護無し 保護有り

解除用のパスワードを入力


実行後

シート1 シート2 シート2
マクロ.xlsm 保護有り 保護無し 保護有り
ブック1.xlsx 保護無し 保護無し 保護無し
ブック2.xlsx 保護無し 保護無し 保護無し

パスワードに誤りがある場合は終了する。


Sub 同じフォルダにある全てのブックの保護を解除する、PW有り()
    パスワード = InputBox(prompt:="解除する為のパスワードを入力してください。")
    Set マクロブック = ThisWorkbook
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Application.DisplayAlerts = False
    For Each ファイル In FSO.GetFolder(ThisWorkbook.Path).Files
        If ファイル.Name = マクロブック.Name Then Exit For
        If ファイル.Name Like "*.xl*" Then
            Set ターゲットブック = Workbooks.Open(ファイル.Name)
            For ターゲットシート = 1 To ターゲットブック.Worksheets.Count
                On Error GoTo エラー処理
                ターゲットブック.Worksheets(ターゲットシート).Unprotect パスワード
            Next
            ターゲットブック.Save: ターゲットブック.Close
        End If
    Next
    Application.DisplayAlerts = True
    Set FSO = Nothing
    Exit Sub
エラー処理:
    Application.DisplayAlerts = True
    Set FSO = Nothing
    MsgBox "ファイル:" & ファイル.Name & vbCrLf & "シート「" & Worksheets(ターゲットシート).Name & "」の保護を解除できませんでした。" & vbCrLf & Err.Description & vbCrLf & vbCrLf & "処理を終了します。"
End Sub

保護(パスワードを指定しない)

開いているシート

マクロ.xlsmのシート1を開いて実行

シート1 シート2 シート2
マクロ.xlsm 保護無し 保護無し 保護無し
ブック1.xlsx 保護無し 保護無し 保護無し
ブック2.xlsx 保護無し 保護無し 保護無し

実行後

シート1 シート2 シート2
マクロ.xlsm 保護有り 保護無し 保護無し
ブック1.xlsx 保護無し 保護無し 保護無し
ブック2.xlsx 保護無し 保護無し 保護無し

Sub 開いているシートを保護する()
    ActiveSheet.Protect
End Sub

開いているブックのシート全て

マクロ.xlsmのシート1を開いて実行

シート1 シート2 シート2
マクロ.xlsm 保護無し 保護無し 保護無し
ブック1.xlsx 保護無し 保護無し 保護無し
ブック2.xlsx 保護無し 保護無し 保護無し

実行後

シート1 シート2 シート2
マクロ.xlsm 保護有り 保護有り 保護有り
ブック1.xlsx 保護無し 保護無し 保護無し
ブック2.xlsx 保護無し 保護無し 保護無し

Sub 全てのシートを保護する()
    For シートカウント = 1 To Worksheets.Count
        Worksheets(シートカウント).Protect
    Next
End Sub

フォルダ内のエクセル全て

マクロ.xlsmのシート1を開いて実行

シート1 シート2 シート2
マクロ.xlsm 保護無し 保護無し 保護無し
ブック1.xlsx 保護無し 保護無し 保護無し
ブック2.xlsx 保護無し 保護無し 保護無し

実行後

シート1 シート2 シート2
マクロ.xlsm 保護無し 保護無し 保護無し
ブック1.xlsx 保護有り 保護有り 保護有り
ブック2.xlsx 保護有り 保護有り 保護有り

Sub 同じフォルダにある全てのブックを保護する()
    Set マクロブック = ThisWorkbook
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Application.DisplayAlerts = False
    For Each ファイル In FSO.GetFolder(ThisWorkbook.Path).Files
        If ファイル.Name = マクロブック.Name Then Exit For
        If ファイル.Name Like "*.xl*" Then
            Set ターゲットブック = Workbooks.Open(ファイル.Name)
            For ターゲットシート = 1 To ターゲットブック.Worksheets.Count
                ターゲットブック.Worksheets(ターゲットシート).Protect
            Next
            ターゲットブック.Save: ターゲットブック.Close
        End If
    Next
    Application.DisplayAlerts = True
    Set FSO = Nothing
End Sub

保護(パスワード有り)

開いているシート

マクロ.xlsmのシート1を開いて実行

シート1 シート2 シート2
マクロ.xlsm 保護無し 保護無し 保護無し
ブック1.xlsx 保護無し 保護無し 保護無し
ブック2.xlsx 保護無し 保護無し 保護無し

保護用のパスワードを入力

実行後

シート1 シート2 シート2
マクロ.xlsm 保護有り 保護無し 保護無し
ブック1.xlsx 保護無し 保護無し 保護無し
ブック2.xlsx 保護無し 保護無し 保護無し

Sub 開いているシートを保護する、PW有り()
    パスワード = InputBox(prompt:="保護する為のパスワードを入力してください。")
    ActiveSheet.Protect パスワード
End Sub

開いているブックのシート全て

マクロ.xlsmのシート1を開いて実行

シート1 シート2 シート2
マクロ.xlsm 保護無し 保護無し 保護無し
ブック1.xlsx 保護無し 保護無し 保護無し
ブック2.xlsx 保護無し 保護無し 保護無し

保護用のパスワードを入力

実行後

シート1 シート2 シート2
マクロ.xlsm 保護有り 保護有り 保護有り
ブック1.xlsx 保護無し 保護無し 保護無し
ブック2.xlsx 保護無し 保護無し 保護無し

Sub 全てのシートを保護する、PW有り()
    パスワード = InputBox(prompt:="保護する為のパスワードを入力してください。")
    For シートカウント = 1 To Worksheets.Count
        Worksheets(シートカウント).Protect パスワード
    Next
End Sub

フォルダ内のエクセル全て

マクロ.xlsmのシート1を開いて実行

シート1 シート2 シート2
マクロ.xlsm 保護無し 保護無し 保護無し
ブック1.xlsx 保護無し 保護無し 保護無し
ブック2.xlsx 保護無し 保護無し 保護無し

保護用のパスワードを入力

実行後

シート1 シート2 シート2
マクロ.xlsm 保護無し 保護無し 保護無し
ブック1.xlsx 保護有り 保護有り 保護有り
ブック2.xlsx 保護有り 保護有り 保護有り

Sub 同じフォルダにある全てのブックを保護する、PW有り()
    パスワード = InputBox(prompt:="保護する為のパスワードを入力してください。")
    Set マクロブック = ThisWorkbook
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Application.DisplayAlerts = False
    For Each ファイル In FSO.GetFolder(ThisWorkbook.Path).Files
        If ファイル.Name = マクロブック.Name Then Exit For
        If ファイル.Name Like "*.xl*" Then
            Set ターゲットブック = Workbooks.Open(ファイル.Name)
            For ターゲットシート = 1 To ターゲットブック.Worksheets.Count
                ターゲットブック.Worksheets(ターゲットシート).Protect パスワード
            Next
            ターゲットブック.Save: ターゲットブック.Close
        End If
    Next
    Application.DisplayAlerts = True
    Set FSO = Nothing
End Sub

コメント

タイトルとURLをコピーしました