时间戳

首页 > 解决方案 > 隐藏取消隐藏工作表崩溃 Excel 工作簿的代码

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

问题描述

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

它会导致 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

标签： excelvba

解决方案

谢谢大家，多多指教！

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

'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

推荐阅读