anonymous ブックシートの保護と解除
No License VBA
2021年11月03日
Copy Clone
Sub 全シートの保護と解除()
    
選択:
    
    Rem 保護の設定・解除の選択
    Dim 選択 As Long
    選択 = Application.InputBox(Prompt:="処理を選択してください" & vbCrLf & vbCrLf & " 1 = 保護   2 = 解除   0 = キャンセル", Type:=1)
    
    Rem キャンセルと再選択
    If 選択 = False Then GoTo キャンセル処理
    If Not (選択 = 1 Or 選択 = 2) Then
        MsgBox "1 か 2 を入力してください"
        GoTo 選択
    End If
    
    Rem パスワードの入力
    Dim GetPW As String
    Select Case 選択
        Case 1
            GetPW = Application.InputBox(Prompt:="保護パスワードを入力してください", Type:=2)
            If GetPW = False Then GoTo キャンセル処理
            Call 保護(GetPW)
        Case 2
            GetPW = Application.InputBox(Prompt:="解除パスワードを入力してください", Type:=2)
            If GetPW = False Then GoTo キャンセル処理
            Call 保護解除(GetPW)
    End Select
    
    Exit Sub
    
キャンセル処理:
    MsgBox "キャンセルしました"
    
End Sub

Sub 保護(ByVal PW As String)
    
    Rem シートの保護
    Dim ws As Worksheet
    For Each ws In Worksheets
        ws.Protect Password:=PW, UserInterfaceOnly:=True     'マクロでの操作は許可
    Next
    
    Rem ブックの保護
    ActiveWorkbook.Protect Password:=PW, Structure:=True, Windows:=False
    
End Sub

Sub 保護解除(ByVal PW As String)
    
    Rem シートの保護解除
    Dim ws As Worksheet
    For Each ws In Worksheets
        ws.Unprotect Password:=PW
    Next
    
    Rem ブックの保護解除
    ActiveWorkbook.Unprotect Password:=PW
    
End Sub
Sub 全シートの保護と解除()
    
選択:
    
    Rem 保護の設定・解除の選択
    Dim 選択 As Long
    選択 = Application.InputBox(Prompt:="処理を選択してください" & vbCrLf & vbCrLf & " 1 = 保護   2 = 解除   0 = キャンセル", Type:=1)
    
    Rem キャンセルと再選択
    If 選択 = False Then GoTo キャンセル処理
    If Not (選択 = 1 Or 選択 = 2) Then
        MsgBox "1 か 2 を入力してください"
        GoTo 選択
    End If
    
    Rem パスワードの入力
    Dim GetPW As String
    Select Case 選択
        Case 1
            GetPW = Application.InputBox(Prompt:="保護パスワードを入力してください", Type:=2)
            If GetPW = False Then GoTo キャンセル処理
            Call 保護(GetPW)
        Case 2
            GetPW = Application.InputBox(Prompt:="解除パスワードを入力してください", Type:=2)
            If GetPW = False Then GoTo キャンセル処理
            Call 保護解除(GetPW)
    End Select
    
    Exit Sub
    
キャンセル処理:
    MsgBox "キャンセルしました"
    
End Sub

Sub 保護(ByVal PW As String)
    
    Rem シートの保護
    Dim ws As Worksheet
    For Each ws In Worksheets
        ws.Protect Password:=PW, UserInterfaceOnly:=True     'マクロでの操作は許可
    Next
    
    Rem ブックの保護
    ActiveWorkbook.Protect Password:=PW, Structure:=True, Windows:=False
    
End Sub

Sub 保護解除(ByVal PW As String)
    
    Rem シートの保護解除
    Dim ws As Worksheet
    For Each ws In Worksheets
        ws.Unprotect Password:=PW
    Next
    
    Rem ブックの保護解除
    ActiveWorkbook.Unprotect Password:=PW
    
End Sub
No one still commented. Please first comment.