Избегайте дублирование имен листов ошибка

Question

У меня есть пользовательские ленты, которые крепятся к модулю «Новый день»

, что я хочу, чтобы избежать дублирования ошибки SheetName, выход к югу, если SheetName будет aready создано и добавление Сообщи «имя aready существует ".

Мой код:

Sub NewDay(control As IRibbonControl) 

    Dim CopySheet As Long 

    CopySheet = MsgBox("New Sheet", vbYesNo, "92x4-4xx9 xx INC") 
    If CopySheet = vbNo Then Exit Sub 
     ActiveSheet.Copy before:=ActiveSheet 
     With ActiveSheet.Range("C1") 
     .Parent.Name = Format(.Value, "mmm-dd-yyyy") 
     Worksheets("Productions").Range("G6:G56").ClearContents 
     Worksheets("Productions").Range("J6:J56").ClearContents 
     Worksheets("Productions").Range("M6:O56").ClearContents 
     Worksheets("Productions").Range("M63:N63").ClearContents 
     Worksheets("Productions").Range("E59:Q59").ClearContents 
     Range("C1") = Format(Date - 1) 
     Sheets("Productions").Activate 
     Productions.Range("G6").Select 
     Range("C1") = Format(Date) 
     End With 

End Sub 

Answer 1

Sub NewDay() 

    Dim CopySheet As Long 

    CopySheet = MsgBox("New Sheet", vbYesNo, "92x4-4xx9 xx INC") 
    If CopySheet = vbNo Then Exit Sub 
     ActiveSheet.Copy before:=ActiveSheet 
     With ActiveSheet.Range("C1") 
      Dim WS_Sheet As Worksheet 
      On Error Resume Next 
      Set WS_Sheet = Sheets(.Parent.Name = Format(.Value, "mmm-dd-yyyy")) 
      On Error GoTo 0 

      If WS_Sheet Is Nothing Then ' Worksheet did not exist 
       .Parent.Name = Format(.Value, "mmm-dd-yyyy") 
       Worksheets("Productions").Range("G6:G56").ClearContents 
       Worksheets("Productions").Range("J6:J56").ClearContents 
       Worksheets("Productions").Range("M6:O56").ClearContents 
       Worksheets("Productions").Range("M63:N63").ClearContents 
       Worksheets("Productions").Range("E59:Q59").ClearContents 
       Range("C1") = Format(Date - 1) 
       Sheets("Productions").Activate 
       Productions.Range("G6").Select 
       Range("C1") = Format(Date) 
      Else ' Worksheet exists 
       ' Handle the problem here 
      End If 
     End With 
End Sub 

Answer 2

Построить процедуру для перехвата и борьбы с ошибками. Вот пример того, как это сделать:

Sub SheetError() 
    Dim MySheet As String 
    On Error GoTo ErrorCheck 
    MySheet = ActiveSheet.Name 
    Sheets.Add 
    ActiveSheet.Name = MySheet 
    MsgBox "I continued the code" 
    Activsheet.Name = "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" 
    MsgBox "I will never get to here in the code" 
    End 
ErrorCheck: 
    If Err.Description = "Cannot rename a sheet to the same name as another sheet, a referenced object library or a workbook referenced by Visual Basic." Then 
     Resume Next 
    Else 
     MsgBox "Error I am not designed to deal with" 
    End If 
End Sub 

Answer 3

Thx guys Я нашел то, что мне нужно.

Sub NewDay(control As IRibbonControl) 

    Dim CopySheet As Long, ws As Workbook 

    CopySheet = MsgBox("New Sheet", vbYesNo, "xxxxxxxxxx") 
    If CopySheet = vbNo Then Exit Sub 
     ActiveSheet.Copy before:=ActiveSheet 
     With ActiveSheet.Range("C1") 
      Dim WS_Sheet As Worksheet, intNumber As Integer 
      On Error Resume Next 
      Set WS_Sheet = Sheets(.Parent.Name = Format(.Value, "mmm-dd-yyyy")) 
      On Error GoTo errHandler 

      intNumber = 0/3 

      If WS_Sheet Is Nothing Then ' Worksheet did not exist 
       .Parent.Name = Format(.Value, "mmm-dd-yyyy") 
       Worksheets("Productions").Range("G6:G56").ClearContents 
       Worksheets("Productions").Range("J6:J56").ClearContents 
       Worksheets("Productions").Range("M6:O56").ClearContents 
       Worksheets("Productions").Range("M63:N63").ClearContents 
       Worksheets("Productions").Range("E59:Q59").ClearContents 
       Range("C1") = Format(Date - 1) 
       Sheets("Productions").Activate 
       Productions.Range("G6").Select 
       Range("C1") = Format(Date) 
      Else ' Worksheet exists 
       ' Handle the problem here 
       Exit Sub 
errHandler: 
       MsgBox Err.Number & Err.Description 
       SendKeys "~" 
       ActiveWindow.SelectedSheets.Delete 

      End If 
     End With 
End Sub