隐藏取消隐藏工作表崩溃 Excel 工作簿的代码

Question

我的代码旨在列出隐藏的工作表、取消隐藏、删除密码、列出文件链接到的工作簿、刷新电源查询数据连接、重新应用密码以及隐藏以前隐藏的工作表以及任何在工作簿打开时显示为绿色的工作表。

它会导致 Excel 崩溃。我尝试多次修改代码，从工作簿中删除代码，将工作簿保存为 .XLS 然后重新打开，重新添加代码并重新保存为 .XLSM。

有什么建议为什么会发生这种情况，或者我可以如何改进代码以防止 Excel 崩溃？

Private Sub Workbook_Open()
'Place in ThisWorkbook to run code on Workbook_Open
'Ensure that Consolidated - Query does NOT have Background Refresh Enabled in Query Properties
    Dim x As Long
    Dim shtCnt As Integer
    shtCnt = ThisWorkbook.Sheets.Count

    Application.StatusBar = "Setting up for volume refresh..."
    Application.Calculation = xlCalculationManual
    Sheets("Control").Visible = True
    Sheets("Control").Activate
    ActiveSheet.Unprotect Password:="passwordhere"
    Sheets("Control").Select

    'clear out old list
    Sheets("Control").Range("T7").Value = "Hidden Worksheets:"
    Range("T7").Select
    Selection.Font.Bold = True
    Selection.Font.Underline = True
    Range("T8:T5000").Select
    Selection.Clear

    'list hidden sheets
    On Error Resume Next
    x = 8
    For i = 1 To shtCnt
        If Sheets(i).Visible = xlSheetHidden Then
            Cells(x, 20) = Sheets(i).Name
            x = x + 1
        End If
    Next i

    'unhide hidden sheets
    stp = Worksheets("Control").Range("T8:T5000").Cells.SpecialCells(xlCellTypeConstants).Count
    y = 8
    For j = 1 To stp
        Sheets(Cells(y, 20).Value).Visible = True
        y = y + 1
    Next j
            
        For i = 1 To Sheets.Count
          With Sheets(i)
            .Unprotect Password:="password"
            .Outline.ShowLevels RowLevels:=1
          End With
        Next i

    'list linked workbooks path
    Application.StatusBar = "Refreshing volume..."
    Dim wb As Workbook
    Set wb = Application.ThisWorkbook
    Sheets("Control").Range("T4").Activate
    If Not IsEmpty(wb.LinkSources(xlExcelLinks)) Then
      xIndex = 4
      For Each link In wb.LinkSources(xlExcelLinks)
        If Not link Like "*Corporate Guidelines Master.xlsm" Then
            Application.ActiveSheet.Cells(xIndex, 20).Value = link
            xIndex = xIndex + 1
        End If
      Next link
    End If
            
    'refresh volume query
    Application.Calculation = xlCalculationAutomatic
    ThisWorkbook.Connections("Query - Consolidated").Refresh
    Application.Wait (Now + TimeValue("0:00:02"))
    DoEvents
    Application.StatusBar = "Please wait..."
        
    For i = 1 To Sheets.Count
        With Sheets(i)
        .Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFormattingColumns:=True, AllowFormattingRows:=True _
        , Password:="passwordhere"
        .Select
        Cells(ThisWindow.SplitRow + 1, ThisWindow.SplitColumn + 1).Select
        End With
    Next i
                    
    'hide originally hidden sheets
    Dim tc As Object
    For Each tc In ThisWorkbook.Sheets
        If tc.Tab.Color = 4697456 Then
            tc.Visible = xlSheetHidden
        End If
    Next tc
    
    stpend = Worksheets("Control").Range("T8:T5000").Cells.SpecialCells(xlCellTypeConstants).Count
    Z = 8
    Sheets("Control").Range("T8").Select
    For k = 1 To stpend
        Sheets(Cells(Z, 20).Value).Visible = False
        Z = Z + 1
    Next k

    'close out
    Sheets("Control").Visible = False
    Sheets("Plant Summary Graphs").Select
    Range("A1").Activate
    Application.StatusBar = False
End
End Sub

Answer 1

谢谢大家的建议！

一个问题是，当工作簿上次关闭然后重新打开时，没有隐藏工作表。所以，我修改了隐藏/取消隐藏工作表代码：

'unhide hidden sheets
    On Error Resume Next
    stp = Worksheets("Control").Range("T8:T5000").Cells.SpecialCells(xlCellTypeConstants).Count
    On Error GoTo 0

    If stp <> "" Then
        y = 8
        For j = 1 To stp
            Sheets(Cells(y, 20).Value).Visible = True
            y = y + 1
        Next j
    End If

希望这不会影响我前进。

谢谢大家！

编辑

隐藏原来隐藏的工作表时我不得不修改以下内容：

On Error Resume Next
stpend = Application.WorksheetFunction.CountA(Worksheets("Control").Range("T8:T5000"))
On Error GoTo 0

If stpend <> "" Then
    Z = 8
    Sheets("Control").Select
    Range("T8").Select
    For k = 1 To stpend
        Sheets(Cells(Z, 20).Value).Visible = False
        Z = Z + 1
    Next k
End If