【ExcelVBA】複数ファイルのシートの保護/保護解除を一括で行う方法

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

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

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

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

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

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

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

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

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

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

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

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