让表格关闭自动保护工作表，如何修改这一段代码

无雨谷

如何让表格关闭自动保护工作表，如何修改下面代码，求助高手

无雨谷

表格原来有一段代码，关闭工作簿只保护sheet1一个工作表，现在想关闭工作簿sheet2/sheet3/sheet4全部自动保护，如何改？请高手帮忙

无雨谷

如何更改原来代码
Private Ac_Name As String, Ac_Codname As String, Sh_Count As String
Private WithEvents shtCopyBtn As CommandBarButton
Private WithEvents cDelsht As cDelShtEvent
Option Explicit

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim q%, ppsw, j%, x%, pt As PivotTable
Dim sh As Worksheet, Sh1 As Worksheet, sh2 As Worksheet
Set Sh1 = Sht1: Set sh2 = Sht2
    On Error Resume Next
    Application.CommandBars("Formatting").Controls(Cap).Delete
    On Error GoTo 0
    If ActiveWorkbook.ReadOnly = True Then ActiveWorkbook.Close False '只讀模式不保存直接退出

    Application.ScreenUpdating = False '關掉屏幕刷新
    Application.EnableEvents = False
    ppsw = Sh1.Cells(Sh1.Range("sn_hq").Row + 1, 2).Value
    If ActiveWorkbook.ProtectStructure = True Then ActiveWorkbook.Unprotect Password:=ppsw '工作薄取消保護
    If Not sh2.Visible = -1 Then sh2.Visible = -1  '取消工作表隱藏
    For Each sh In Worksheets
        If sh.ProtectContents = True Then sh.Unprotect Password:=ppsw '取消工作表保護
        sh.Cells.Locked = True
        sh.Protect Password:=ppsw, DrawingObjects:=False, Contents:=True, Scenarios:= _
            False, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
            AllowFormattingRows:=True, AllowInsertingRows:=True, _
            AllowInsertingHyperlinks:=True, AllowSorting:=True, AllowFiltering:=True _
            , AllowUsingPivotTables:=True '工作表保護
        If Not sh.CodeName = sh2.CodeName Then If sh.Visible = -1 Then sh.Visible = 2 '工作表隱藏
    Next sh
    'If ActiveWorkbook.ProtectStructure = False Then ActiveWorkbook.Protect Password:=ppsw '工作薄保護
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    On Error Resume Next
    If Not cDelsht Is Nothing Then  '禁刪工作表代碼
        cDelsht.Enable = False  '禁刪工作表代碼
        Set cDelsht = Nothing  '禁刪工作表代碼
    End If
    On Error GoTo 0
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

Private Sub Workbook_Open()
    Call AddToolbar
    UserForm1.Show   '啟動窗體
    ''Application.Visible = False '窗體隱藏
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    On Error Resume Next
    Set shtCopyBtn = Application.CommandBars.FindControl(id:=848) '禁刪工作表代碼
    Set cDelsht = New cDelShtEvent  '禁刪工作表代碼
    cDelsht.Enable = True  '禁刪工作表代碼
    On Error GoTo 0
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
End Sub
Private Sub Workbook_NewSheet(ByVal sh As Object)
    sh.Move after:=Sheets(Sheets.Count) '新建表移到最後
    Sheets(Sheets.Count).Activate
    Call mlsy
End Sub
Private Sub Workbook_SheetActivate(ByVal sh As Object) '工作表激活事件
    Ac_Name = ActiveSheet.Name
    Ac_Codname = ActiveSheet.CodeName
End Sub
Private Sub Workbook_sheetDeactivate(ByVal sh As Object) '工作表取消激活事件
    If sh.CodeName = Ac_Codname Then
        If sh.Name <> Ac_Name Then Call mlsy
    End If
End Sub
Private Sub shtCopyBtn_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean) '工作表移動與複製事件?

End Sub

'Private Sub Workbook_BeforeClose(Cancel As Boolean)
'    If Not cDelsht Is Nothing Then
'        cDelsht.Enable = False
'        Set cDelsht = Nothing
'    End If
'End Sub

'Private Sub Workbook_Open()
    'Set cDelsht = New cDelShtEvent
'   cDelsht.Enable = True
'End Sub

Private Sub cDelsht_WorkBookDelSheet(ByVal wb As Workbook, ByVal shts As Object)
    Dim res As Variant, sht As Object
    If shts.Count = 1 Then
        res = MsgBox("Whether to delete" & shts(1).Name & "worksheet ?", vbQuestion + vbYesNo, Me.Name)
    Else
        res = MsgBox("Whether to delete the selected" & shts.Count & "A worksheet ?", vbQuestion + vbYesNo, Me.Name)
    End If
    If res = vbYes Then
        Application.DisplayAlerts = False
        For Each sht In shts
        If sht.CodeName = "Sht1" Or sht.CodeName = "Sht2" Or sht.CodeName = "Sht3" Or sht.CodeName = "Sht4" Then
            MsgBox "named "" & sht.Name & "" The worksheet can't be deleted", vbCritical
        Else
            sht.Delete
            Call mlsy '給新工作表建立索引
        End If
        Next
            Application.DisplayAlerts = True
    End If
End Sub

无雨谷

如何修改，实现关闭工作簿自动保护工作表，自定义密码为9999。原来代码只保护第一个工作表，现在想全部保护，如何修改请高手帮忙

无雨谷

无人帮忙