チェックボックスと重複シートのエラー

Question

チェックボックスに基づいて新しいワークシートを作成するコードを設計しました。この名前はユーザー定義変数から派生しています。しかし、誰かがボックスのチェックを外してチェックすると、コードを再度実行し、同じ名前を持つ複数のワークシートが原因でエラーが発生します。私はこれが正常に機能しているコードだと理解していますが、名前が存在するかどうかをコードがチェックするIF：THENステートメントを作成します。シートが存在する場合、コード自体が停止します。シートが存在しない場合は、正常に実行されます。

どうすればいいですか？

以下のコード。

Private Sub CheckBox4_Click() 

Application.ScreenUpdating = False 
Dim ws As Worksheet 
Dim Protocol As Range 

If CheckBox4.Value = True Then 

ActiveWorkbook.Unprotect 

Set ws = Sheets.Add(After:=Sheets(Sheets.Count)) 
ws.Name = Sheets("Control").Cells(16, "I") 
Set Protocol = Sheets("The Hidden Works").Columns("W:AQ").EntireColumn 
Protocol.Copy 
ws.Paste 
ws.Protect 
ws.EnableSelection = xlUnlockedCells 
Application.CutCopyMode = False 

     Worksheets("SUMMARY").Rows("44").EntireRow.Hidden = False 
     Worksheets("SUMMARY").Cells(44, 3).Value = "='Control'!I16" 
     Worksheets("SUMMARY").Cells(44, 3).NumberFormat = "General" 
     Worksheets("SUMMARY").Cells(44, 4).Value = "='Control'!K16" 
     Worksheets("SUMMARY").Cells(44, 5).Value = "='Control'!L16" 
     Worksheets("SUMMARY").Cells(44, 6).Value = "=" & ws.Name & "!$H$69" 
     Worksheets("SUMMARY").Cells(44, 7).Value = "=" & ws.Name & "!$J$69" 
     Worksheets("SUMMARY").Cells(44, 8).Value = "=" & ws.Name & "!$N$69" 
     Worksheets("SUMMARY").Cells(44, 9).Value = "=" & ws.Name & "!$P$69" 
     Worksheets("SUMMARY").Cells(44, 10).Value = "=SUM(F44:I44)/D44" 
     Worksheets("SUMMARY").Cells(44, 11).Value = "=M44/F3" 
     Worksheets("SUMMARY").Cells(44, 12).Value = "=" & ws.Name & "!$U$69" 
     Worksheets("SUMMARY").Cells(44, 13).Value = "=M44/$K$57" 

Worksheets("Control").Activate 

End If 
    Application.ScreenUpdating = True 
End Sub 

Answer 1

あなたはシートが存在するかどうかを確認するには、以下の機能を使用することができます。

Function WorksheetExists(sheetName As String) As Boolean 
    WorksheetExists = Evaluate("ISREF('" & sheetName & "'!A1)") 
End Function 

は次のようにそれを使用して、

If WorksheetExists("Sheet10") Then 
    Exit Sub 
Else 
    'Your Code 
End If 

あなたのコードは、ソリューションを使用するように適合：

Private Sub CheckBox4_Click() 

Application.ScreenUpdating = False 
Dim ws As Worksheet 
Dim Protocol As Range 
Dim sheetName As String 

If CheckBox4.Value = True Then 
    ActiveWorkbook.Unprotect 
    sheetName = Sheets("Control").Cells(16, "I") 
    If WorksheetExists(sheetName) Then 
     Exit Sub 
    Else 
     Set ws = Sheets.Add(After:=Sheets(Sheets.Count)) 
     ws.Name = sheetName 
     Set Protocol = Sheets("The Hidden Works").Columns("W:AQ").EntireColumn 
     Protocol.Copy 
     ws.Paste 
     ws.Protect 
     ws.EnableSelection = xlUnlockedCells 
     Application.CutCopyMode = False 

     Worksheets("SUMMARY").Rows("44").EntireRow.Hidden = False 
     Worksheets("SUMMARY").Cells(44, 3).Value = "='Control'!I16" 
     Worksheets("SUMMARY").Cells(44, 3).NumberFormat = "General" 
     Worksheets("SUMMARY").Cells(44, 4).Value = "='Control'!K16" 
     Worksheets("SUMMARY").Cells(44, 5).Value = "='Control'!L16" 
     Worksheets("SUMMARY").Cells(44, 6).Value = "=" & ws.Name & "!$H$69" 
     Worksheets("SUMMARY").Cells(44, 7).Value = "=" & ws.Name & "!$J$69" 
     Worksheets("SUMMARY").Cells(44, 8).Value = "=" & ws.Name & "!$N$69" 
     Worksheets("SUMMARY").Cells(44, 9).Value = "=" & ws.Name & "!$P$69" 
     Worksheets("SUMMARY").Cells(44, 10).Value = "=SUM(F44:I44)/D44" 
     Worksheets("SUMMARY").Cells(44, 11).Value = "=M44/F3" 
     Worksheets("SUMMARY").Cells(44, 12).Value = "=" & ws.Name & "!$U$69" 
     Worksheets("SUMMARY").Cells(44, 13).Value = "=M44/$K$57" 

     Worksheets("Control").Activate 
    End If 
End If 
    Application.ScreenUpdating = True 
End Sub 

Function WorksheetExists(sheetName As String) As Boolean 
    WorksheetExists = Evaluate("ISREF('" & sheetName & "'!A1)") 
End Function 

Answer 2

セルがチェックするために、具体的命名シート：

Application.DisplayAlerts = False 
If IsError(Evaluate("SHEETNAME!A1")) Then Sheets.Add(After:=Sheets(Sheets.Count)).Name = "SHEETNAME" 
Application.DisplayAlerts = True