奇數的excel-vba運行時錯誤並且不會刪除現有的表

Question

我正在運行這個VBA錯誤並且不知道爲什麼我每次都收到這個錯誤第三個我運行宏的時候（前兩個運行正常）。

的錯誤是：

「運行時錯誤 '-2147417848（80010108）'： 方法object'_Worksheet'failed的 '刪除'」

調試器指向「工作表（內容名）。刪除「刪除內容表如果它已存在評論代碼。

這段代碼的目的：要通過工作表名稱鏈接到所有工作表工作簿中的一個表創建一個目錄

我創建運行宏再次更新按鈕在添加新工作表時的目錄。

Sub TableOfContents_Create() 
'PURPOSE: Add a Table of Contents worksheets to easily navigate to any tab 
'SOURCE: www.TheSpreadsheetGuru.com 

Dim sht As Worksheet 
Dim Content_sht As Worksheet 
Dim myArray As Variant 
Dim x As Long, y As Long 
Dim shtName1 As String, shtName2 As String 
Dim ContentName As String 

'Inputs 
    ContentName = "Job List" 

'Optimize Code 
    Application.DisplayAlerts = False 
    Application.ScreenUpdating = False 

'Delete Contents Sheet if it already exists 
    On Error Resume Next 
    Worksheets("Job List").Activate 
    On Error GoTo 0 

    If ActiveSheet.Name = ContentName Then 
    myAnswer = MsgBox("A worksheet named [" & ContentName & _ 
     "] has already been created, would you like to replace it?", vbYesNo) 

    'Did user select No or Cancel? 
     If myAnswer <> vbYes Then GoTo ExitSub 

    'Delete old Contents Tab 
     Worksheets(ContentName).Delete 
    End If 

'Create New Contents Sheet 
    Worksheets.Add Before:=Worksheets(1) 

'Set variable to Contents Sheet 
    Set Content_sht = ActiveSheet 

'Format Contents Sheet 
    With Content_sht 
    .Name = ContentName 
    .Range("B2") = "Jobs" 
    .Range("B2").Font.Bold = True 
    End With 

'Create Array list with sheet names (excluding Contents) 
    ReDim myArray(1 To Worksheets.Count - 1) 

    For Each sht In ActiveWorkbook.Worksheets 
    If sht.Name <> ContentName Then 
     myArray(x + 1) = sht.Name 
     x = x + 1 
    End If 
    Next sht 

'Alphabetize Sheet Names in Array List 
    For x = LBound(myArray) To UBound(myArray) 
    For y = x To UBound(myArray) 
     If UCase(myArray(y)) < UCase(myArray(x)) Then 
     shtName1 = myArray(x) 
     shtName2 = myArray(y) 
     myArray(x) = shtName2 
     myArray(y) = shtName1 
     End If 
    Next y 
    Next x 

'Create Table of Contents 
    For x = LBound(myArray) To UBound(myArray) 
    Set sht = Worksheets(myArray(x)) 
    sht.Activate 
    With Content_sht 
     .Hyperlinks.Add .Cells(x + 2, 3), "", _ 
     SubAddress:="'" & sht.Name & "'!A1", _ 
     TextToDisplay:=sht.Name 
     .Cells(x + 2, 2).Value = x 
    End With 
    Next x 

Content_sht.Activate 
Content_sht.Columns(3).EntireColumn.AutoFit 

'A Splash of Guru Formatting! [Optional] 
    Columns("A:B").ColumnWidth = 3.86 
    Range("B1").Font.Size = 18 
    Range("B1:F1").Borders(xlEdgeBottom).Weight = xlThin 

    With Range("B3:B" & x + 1) 
    .Borders(xlInsideHorizontal).Color = RGB(255, 255, 255) 
    .Borders(xlInsideHorizontal).Weight = xlMedium 
    .HorizontalAlignment = xlCenter 
    .VerticalAlignment = xlCenter 
    .Font.Color = RGB(255, 255, 255) 
    .Interior.Color = RGB(91, 155, 213) 
    End With 

'Adjust Zoom and Remove Gridlines 
    ActiveWindow.DisplayGridlines = False 
    ActiveWindow.Zoom = 130 




'Pulls the name of the work book and displays it at the top 
    With Content_sht 
     .Name = ContentName 
     .Range("B1") = ThisWorkbook.Name 
     .Range("B1").Font.Bold = True 
    End With 


'Create a refresh button 
    ActiveSheet.Buttons.Add(Range("G4").Left, Range("G4").Top, 90, 25).Select 
    Selection.Name = "btnRefreshList" 
    Selection.OnAction = "TableOfContents_Create" 
    ActiveSheet.Shapes("btnRefreshList").Select 
    With Selection 
     .Characters.Text = "Refresh List" 
     With .Font 
      .Name = "Arial" 
      .FontStyle = "Bold" 
      .Size = 12 
     End With 
    End With 

'Create a New Job Button 
    ActiveSheet.Buttons.Add(Range("G2").Left, Range("G2").Top, 90, 25).Select 
    Selection.Name = "btnNewJob" 
    Selection.OnAction = "NewJob" 
    ActiveSheet.Shapes("btnNewJob").Select 
    With Selection 
     .Characters.Text = "New Job" 
     With .Font 
      .Name = "Arial" 
      .FontStyle = "Bold" 
      .Size = 12 
     End With 
    End With 

ExitSub: 
'Optimize Code 
    Application.DisplayAlerts = True 
    Application.ScreenUpdating = True 

End Sub 


'Create a new job worksheet 
Private Sub NewJob() 
Dim ws1 As Worksheet 
    Set ws1 = ThisWorkbook.Worksheets("Master") 
    ws1.Copy ThisWorkbook.Sheets(Sheets.Count) 
End Sub 

Answer 1

我要發表評論，我無法重現錯誤，但@mock_blatt給我，也許代碼被一個表模塊在運行的線索。

用兩張表創建一本新書，重新命名爲Job List並將代碼粘貼到它的模塊中。必須爲undefined myAnswer變量添加聲明。運行代碼。

雖然你可以關閉其中的代碼運行似乎表的代碼模塊中，你不能從一個Sub運行刪除表

移動你的代碼到一個標準模塊的工作簿和它應該運行正常。