复选框和重复工作表错误

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

您可以评估特定命名的工作表上是否存在要检查的单元格：

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

Answer 2

您可以使用以下函数来检查 Sheet 是否存在：

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