' ===================================
' модуль книги
' ===================================

' недостаток противоположный описаному в п.3
' книга принудительно сохраняется при закрытии
' при этом все листы, с которыми работали, становятся защищенными

Option Explicit

Dim col As Collection
Dim oldSheet

' ===================================
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    With oldSheet
    If Not IsNull(col(.Name)) Then _
        .Protect Password:=col(.Name)
    End With
    Set oldSheet = Nothing: Set col = Nothing
    ThisWorkbook.Save
End Sub
' ===================================
Private Sub Workbook_Open()
    Dim w
    Set col = New Collection
    For Each w In Worksheets
        col.Add Null, w.Name
    Next w
    Set oldSheet = ActiveSheet
End Sub
' ===================================
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    Dim s$
    'Exit Sub
    With oldSheet
    If Not IsNull(col(.Name)) Then _
        .Protect Password:=col(.Name)
    End With
    
    Set oldSheet = Sh
    
    With Sh
        If IsNull(col(.Name)) Then
            s = InputBox("Enter the password for the worksheet")
        Else
            s = col(.Name)
        End If
        
        On Error Resume Next
        .Unprotect Password:=s
        If Err.Number =  0  Then
            If IsNull(col(.Name)) Then
' извращение с удалением и созданием элемента потому
' что так и не нашел как изменить существующий элемент :(
' вариант col(.name)=s не сработал
' может у меня руки не так заточены?
                col.Remove .Name: col.Add s, .Name
            End If
        End If
        Err.Clear
    End With 'Sh
    
End Sub