VBA Создание листов, обработка ошибок

Question

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

Я сделал это так, так как мне нужно скопировать макет и форматирование скрытого листа.

Проблема, с которой я столкнулся, заключается в том, что когда я нажимаю кнопку «Создать», если лист уже выходит, он полностью сбой Excel, я попытался добавить обработку ошибок, но все, что я пытался проверить, существует ли лист, t работает и по-прежнему выдает Excel.

Отделили код, который не скрывает лист шаблона, копирует его, переименовывает новый лист и затем скрывает шаблон.

Что бы я хотел сделать, это проверить введенное имя листа из TextBox5, и проверить, существует ли лист, если он отображает окно с сообщением, если лист уже существует, если лист не существует, они несут с кодом как обычно.

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

Private Sub CommandButton3_Click() 
     Dim wb As Workbook: Set wb = ThisWorkbook 
     Dim ws As Worksheet: Set ws = wb.Sheets("Template") 
     Dim newws As Worksheet, sh As Worksheet, newname 
     Dim query As Long, xst As Boolean, info As String 
     Dim NextRow As Long, myCCName As Variant, lastRow2 As Long, lastRow As Long 
     'Contract Name 
     Dim Contact As String, name As String, name2 As String, SpacePos As Integer 
     Dim answer As Integer 
    With Application 
     .ScreenUpdating = False 
     .EnableEvents = False 
     .CutCopyMode = False 
    End With 

    lastRow2 = Sheets("Payment Form").Range("A18:A34").End(xlDown).Row 
    lastRow = Sheets("Payment Form").Range("U36:U53").End(xlDown).Row 

    'Contract Name 
    Set contract = Sheets("Payment Form").Range("C9") 
    SpacePos = InStr(contract, "- ") 
    name = Left(contract, SpacePos) 
    name2 = Right(contract, Len(contract) - Len(name)) 
    ' 
    retry: 
     xst = False 
     newname = Me.TextBox5.Value 
     myCCName = Me.TextBox4.Value 
     If newname = "" Then 
      MsgBox "You have not entered a CC Code Number. Please enter CC Code Number!", vbExclamation, "An Error Occured" 
     Exit Sub 
     End If 
     If myCCName = "" Then 
      MsgBox "You have not entered a CC Code Name. Please enter CC Code Name!", vbExclamation, "An Error Occured" 
     Exit Sub 
     End If 
     For Each sh In wb.Sheets 
      If sh.name = newname Then 
       xst = True: Exit For 
      End If 
     Next 
     If Len(newname) = 0 Or xst = True Then 
      info = "Sheet name is invalid. Please retry." 
      GoTo retry 
     End If 

Sheets("Template").Visible = True 
ws.Copy before:=Sheets("Details"): Set newws = ActiveSheet: newws.name = newname 
Sheets("Template").Visible = False 

With ActiveWorkbook.Sheets("Payment Form").Activate 
    For Each cell In Columns(1).Range("A18:A34").Cells 
     If Len(cell) = 0 Then cell.Select: Exit For 
    Next cell 
    ActiveCell.Value = newname & " " & "-" & name2 & ":" & " " & myCCName 
End With 

With ActiveWorkbook.Sheets(newname).Activate 
    ActiveWorkbook.Sheets(newname).Range("D4") = Sheets("Payment Form").Range("a18:a34").End(xlDown).Value 
    ActiveWorkbook.Sheets(newname).Range("D6") = Sheets("Payment Form").Range("L11").Value 
    ActiveWorkbook.Sheets(newname).Range("D8") = Sheets("Payment Form").Range("C9").Value 
    ActiveWorkbook.Sheets(newname).Range("D10") = Sheets("Payment Form").Range("C11").Value 
End With 

ActiveWorkbook.Sheets("Payment Form").Activate 

With ActiveWorkbook.Sheets("Payment Form") 
    Range("J" & lastRow2 + 1) = 0 
    Range("L" & lastRow2 + 1).Formula = "=N" & lastRow2 + 1 & "-J" & lastRow2 + 1 & "" 
    Range("N" & lastRow2 + 1).Formula = "='" & newname & "'!L20" 
    Range("U" & lastRow + 1) = newname & ":" & " " 
    Range("V" & lastRow + 1).Formula = "='" & newname & "'!I21" 
    Range("W" & lastRow + 1).Formula = "='" & newname & "'!L23" 
    Range("X" & lastRow + 1).Formula = "='" & newname & "'!K21" 
End With 

answer = MsgBox("Would you like to create another sheet?", vbYesNo + vbQuestion, "New Sheet") 

If answer = vbYes Then 

Else 
    Unload Me 
End If 

    With Application 
     .ScreenUpdating = True 
     .EnableEvents = True 
     .CutCopyMode = True 
    End With 

    Me.TextBox4.Value = "" 
    Me.TextBox5.Value = "" 
End Sub 

Answer 1

Там, как представляется, несколько общих опечаток и несколько ошибок с «С» заявлений по всему коду. Я надеюсь, что убрал и переработал функцию для работы, но поскольку она непроверена, я не могу гарантировать, что она будет работать с места в карьер.

Я также включил контрольную функцию рабочего листа в виде отдельной функции

Private Sub CommandButton3_Click() 

    Dim wb As Workbook: Set wb = ThisWorkbook 
    Dim wsTemplate As Worksheet: Set wsTemplate = wb.Sheets("Template") 
    Dim wsPayment As Worksheet: Set wsPayment = wb.Sheets("Payment Form") 
    Dim wsNew As Worksheet 

    Dim NewName As String: NewName = Me.TextBox5.Value 
    Dim CCName As Variant: CCName = Me.TextBox4.Value 

    If NewName = "" Or CCName = "" Then 
     MsgBox "CC Code Name or Number missing. Please check details!", vbExclamation, "An Error Occured" 
     Exit Sub 
    End If 

    If WorksheetExists(NewName) Then 
     MsgBox "Sheet name already exists. Please retry!", vbExclamation, "An Error Occured" 
     Exit Sub 
    End If 

    With Application 
     .ScreenUpdating = False 
     .EnableEvents = False 
     .CutCopyMode = False 
    End With 

    Dim lastRow As Long: lastRow = wsPayment.Range("U36:U53").End(xlDown).Row 
    Dim lastRow2 As Long: lastRow2 = wsPayment.Range("A18:A34").End(xlDown).Row 

    'Contract Name 
    Dim Contract As String: Contract = Sheets("Payment Form").Range("C9").Value 
    Dim SpacePos As Integer: SpacePos = InStr(Contract, "- ") 
    Dim Name As String: Name = Left(Contract, SpacePos) 
    Dim Name2 As String: Name2 = Right(Contract, Len(Contract) - Len(Name)) 

    wsTemplate.Visible = True 
    wsTemplate.Copy before:=Sheets("Details"): Set wsNew = ActiveSheet 
    wsTemplate.Visible = False 

    With wsPayment 
     For Each Cell In .Range("A18:A34") 
      If Len(Cell) = 0 Then 
       Cell.Value = NewName & " -" & Name2 & ": " & CCName 
       Exit For 
      End If 
     Next Cell 
    End With 

    With wsNew 
     .Name = NewName 
     .Range("D4").Value = wsPayment.Range("A18:A34").End(xlDown).Value 
     .Range("D6").Value = wsPayment.Range("L11").Value 
     .Range("D8").Value = wsPayment.Range("C9").Value 
     .Range("D10").Value = wsPayment.Range("C11").Value 
    End With 

    With wsPayment 
     .Range("J" & lastRow2 + 1).Value = 0 
     .Range("L" & lastRow2 + 1).Formula = "=N" & lastRow2 + 1 & "-J" & lastRow2 + 1 & "" 
     .Range("N" & lastRow2 + 1).Formula = "='" & NewName & "'!L20" 
     .Range("U" & lastRow + 1).Value = NewName & ": " 
     .Range("V" & lastRow + 1).Formula = "='" & NewName & "'!I21" 
     .Range("W" & lastRow + 1).Formula = "='" & NewName & "'!L23" 
     .Range("X" & lastRow + 1).Formula = "='" & NewName & "'!K21" 
    End With 

    With Application 
     .ScreenUpdating = True 
     .EnableEvents = True 
     .CutCopyMode = True 
    End With 

    Dim Answer As Integer: Answer = MsgBox("Would you like to create another sheet?", _ 
     vbYesNo + vbQuestion, "New Sheet") 
    If Answer = vbNo Then Unload Me 

    Me.TextBox4.Value = "" 
    Me.TextBox5.Value = "" 
End Sub 

Public Function WorksheetExists(ByVal WorksheetName As String) As Boolean 
    On Error Resume Next 
    WorksheetExists = (ThisWorkbook.Sheets(WorksheetName).Name <> "") 
    On Error GoTo 0 
End Function 

Answer 2

Лично я использовать функцию ниже, чтобы проверить, если лист Allready существуют в книге, и в этом случае она возвращает True:

Public Function doItExist(strSheetName as String) As Boolean 
    Dim wsTest As Worksheet: Set wsTest = Nothing 

    On Error Resume Next 
    Set wsTest = ThisWorkbook.Worksheets(strSheetName) 
    On Error GoTo 0 

    If wsTest Is Nothing Then 
     doExist = False 
    Else 
     doExist = True 
    End If 

End Function 

не могу похоже, чтобы найти исходный код для кода, но я не могу взять кредит, это мучительно измененная версия некоторого кода, который я нашел на любом S O, OzGrid или Mrexcel

EDIT:

Присмотревшись ваш код, кажется, вы Allready проверить существование SheetName в переменной XST. Насколько я вижу, пользователь не может обновить имя листа, если он недействителен, так как блок повторных попыток будет продолжать цикл?

под повторить попытку:

'### This bit essentially does the same as doSheetExist 
For Each sh In wb.Sheets 
    If sh.name = newname Then 
     xst = True: Exit For 
    End If 
Next 
'### 

If Len(newname) = 0 Or xst = True Then 'if you go for the doSheetExist, then the xst check is obsolete. Else move the xst check to the elseif and remove the doSheetExist call 
    info = "Sheet name is invalid. Please retry." 
    'GoTo retry 'As far as I can tell calling retry would just cause an infinite loop as the user have had no chance to update sheetname 
    Exit Sub 'let the user update and click the button again 
ElseIf doSheetExist(newname) = True Then 
    info = "Sheet name allready exist. Please specify other sheetname" 
    Exit Sub 
End If