Почему моя процедура удаления не работает во второй раз?

Question

Я написал следующие коды, чтобы вставить новые листы, переименовать их и удалить их. Но когда я вызываю субтитры delete во второй раз, это не сработает, потому что NumSheets обращается в нуль и даже если имеется более двух листов.

Public NumSheets As Integer 
Sub NewCCSheet() 
    Dim n As Integer 

    n = InputBox("How many 16-24 Vehicle C.C.sheets do you need? (Enter a number only)") 

    NewVehicle (n) 
End Sub 
Function NewVehicle(n As Integer) 
    For i = 1 To n 
     NumSheets = NumSheets + 1 
     Worksheets("16-24 Vehicle C.C.1").Copy Before:=Worksheets("Ave. Vehicle C.C.") 
     ActiveSheet.Name = "16-24 Vehicle C.C." & CStr(NumSheets + 1) 
     Range("B5").ClearContents 
     Range("D4").ClearContents 
     Range("E12:E13").ClearContents 
     Range("B15:E23").ClearContents 
     MsgBox NumSheets 
    Next i 
End Function 
Sub DeleteSheets() 
    MsgBox NumSheets 
    Dim Ans As String 
    If NumSheets = 0 Then 
     MsgBox "You can't delete 16-24 Vehicle C.C.1 Worksheet" 
     Exit Sub 
    End If 
    Ans = MsgBox("Delete current worksheet?", vbYesNo) 
    If Ans = vbYes Then 
     NumSheets = NumSheets - 1 
     On Error Resume Next 
     Application.DisplayAlerts = False 
     ActiveSheet.Delete 
     Application.DisplayAlerts = True 
     MsgBox NumSheets 
    End If 
End Sub 

Answer 1

Есть некоторые случаи, когда ваш код может вычитать 1 из NumSheets без удаления листа - например, я не верю, что бы удалить последний лист из книги, если есть только один слева. On Error Resume Next открывает потенциал для других ошибок, вызывающих несоответствия между NumSheets и фактическим количеством листов.

Можете ли вы использовать Sheets().Count вместо NumSheets? Если это так, это даст вам актуальный, точный подсчет фактического количества листов в данный момент времени, и вам не придется связываться с отслеживанием их количества самостоятельно. Так что ваш код может выглядеть следующим образом:

Sub NewCCSheet() 
    Dim n As Integer 

    n = InputBox("How many 16-24 Vehicle C.C.sheets do you need? (Enter a number only)") 

    NewVehicle (n) 
End Sub 

Function NewVehicle(n As Integer) 
    For i = 1 To n 
     Worksheets("16-24 Vehicle C.C.1").Copy Before:=Worksheets("Ave. Vehicle C.C.") 
     ActiveSheet.Name = "16-24 Vehicle C.C." & CStr(Sheets().Count + 1) 
     Range("B5").ClearContents 
     Range("D4").ClearContents 
     Range("E12:E13").ClearContents 
     Range("B15:E23").ClearContents 
    Next i 
End Function 

Sub DeleteSheets() 
    Dim Ans As String 
    If Sheets().Count = 0 Then 
     MsgBox "You can't delete 16-24 Vehicle C.C.1 Worksheet" 
     Exit Sub 
    End If 
    Ans = MsgBox("Delete current worksheet?", vbYesNo) 
    If Ans = vbYes Then 
     On Error Resume Next 
     Application.DisplayAlerts = False 
     ActiveSheet.Delete 
     Application.DisplayAlerts = True 
    End If 
End Sub