anonymous ブックとシートの保護
No License VBA
2021年11月02日
Copy Clone
Sub 全シートの保護と解除()
    
    On Error GoTo キャンセル処理
    
    Rem 保護の設定・解除の選択
    Dim 選択 As Long
    選択 = InputBox("処理を選択してください" & vbCrLf & vbCrLf & "保護 = 1  解除 = 2")
    
    On Error GoTo 0
    
    Rem パスワードの入力
    Dim GetPW As String
    GetPW = InputBox("パスワードを入力してください")
    
    Select Case 選択
        Case 1
            Call 保護(GetPW)
        Case 2
            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 全シートの保護と解除()
    
    On Error GoTo キャンセル処理
    
    Rem 保護の設定・解除の選択
    Dim 選択 As Long
    選択 = InputBox("処理を選択してください" & vbCrLf & vbCrLf & "保護 = 1  解除 = 2")
    
    On Error GoTo 0
    
    Rem パスワードの入力
    Dim GetPW As String
    GetPW = InputBox("パスワードを入力してください")
    
    Select Case 選択
        Case 1
            Call 保護(GetPW)
        Case 2
            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
anonymous
Anonymous
2021年11月03日
【修正版】 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