vba - 错误处理完成后出现奇怪的错误行为

Question

我正在使用一个创建唯一工作表名称的子程序，方法是尝试输入名称并重定向错误，直到找到有效名称为止。

子程序可以工作，但是退出子程序并尝试在oleobject复选框中测试值之后，它给了我以前重定向的错误-也就是说，除非我执行其他调用，例如ws.Activate或application.screenupdating = false。我尝试将Err.Clear放置在代码中的各个点上，但没有成功。

我是VBA的新手(使用它不到一个月)，所以请原谅我的明显错误。

我正在使用Excel 2013。

首先运行此命令以在Sheet1中创建复选框，并使用指定名称创建一个新工作表:

Private Sub runfirst()

    Dim cb1 As OLEObject
    Dim ws As Worksheet

    Sheet1.OLEObjects.Delete
    Set cb1 = Sheet1.OLEObjects.Add(ClassType:="Forms.CheckBox.1")
    cb1.Name = "CheckBox1"
    cb1.Object.Caption = "Checkbox1"

    Set ws = ThisWorkbook.Sheets.Add
    ws.Name = "mysheet"

End Sub

主要代码:

Private Sub test1()
    'This throws an error
    Dim ws As Worksheet

    Set ws = ThisWorkbook.Sheets.Add
    NameWS rootname:="mysheet", ws:=ws
    'ws.Activate
    If Sheet1.CheckBox1.Value = True Then MsgBox "true" Else MsgBox "false"

End Sub

Private Sub test2()
    ' This works fine
    Dim ws As Worksheet

    Set ws = ThisWorkbook.Sheets.Add
    NameWS rootname:="mysheet", ws:=ws
    ws.Activate
    If Sheet1.CheckBox1.Value = True Then MsgBox "true" Else MsgBox "false"

End Sub


Private Sub NameWS(rootname As String, ws As Worksheet)
    ' This sub tries to name the WS as rootname, if it fails, it increments a counter in the name.

    Dim ctr As Long
    ctr = 0

    On Error GoTo Err1:
    ws.Name = rootname
    Exit Sub

BaseNameTaken:
    ctr = ctr + 1
    On Error GoTo Err1:
    ws.Name = rootname & " (" & ctr & ")"
    ' If execution makes it to here it means that a valid name has been found

    On Error GoTo 0
    Exit Sub

Err1:
    If ctr > 99 Then Resume Fail ' Just to ensure we haven't created an infinite loop
    Resume BaseNameTaken

Fail:
    ' Leave sub. Inability to name WS is not a critical error.
    MsgBox "Failed to name worksheet after " & ctr & " tries. Excel default name used."

End Sub

Answer 1

这是设置Application.DisplayAlerts的问题

您可能要使用此功能

Private Sub NameWS(rootname As String, ws As Worksheet)
    Dim ctr As Long
    Application.DisplayAlerts = False
    Do
        On Error Resume Next
        ws.name = rootname & IIf(ctr = 0, "", " (" & ctr & ")")
        ctr = ctr + 1
    Loop While Err > 0
    Application.DisplayAlerts = True
End Sub

此外，该行:

If Sheet1.CheckBox1.Value = True Then MsgBox "true" Else MsgBox "false"

可以简化为:

MsgBox Sheet1.CheckBox1.Value