错误处理完成后的奇怪错误行为

Question

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

sub 可以工作，但是在退出 sub 并尝试测试 oleobject 复选框中的值后，它给了我之前重定向的错误——除非我执行其他调用，例如 ws.Activate 或 application.screenupdating = false。我曾尝试在代码的不同位置放置 Err.Clear 但没有成功。

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

我正在使用 excel 2013.

运行这首先在 Sheet1 中创建复选框并创建一个具有指定名称的新 sheet:

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

我不喜欢On Error Goto Label。我发现跳来跳去的代码很难理解，也很难正确。

下面的宏是我如何编写例程。

首先，几点可能会有帮助。

我有一个名为 Resources 的文件夹，其中包含子文件夹 "VBA"、"VBA Excel" 和 "VBA Outlook"。如果我使用 VBA Word 或 VBA Access，我也会为它们创建子文件夹。每当我完成开发时，我都会查看我的代码，寻找我可能会再次使用的例程。如果例程是通用的VBA，则在"VBA"中保存为文本文件。对于您的例程，我会将其保存为文件夹“VBA Excel”中的“NameWS .txt”。

宏首先解释了它的作用。如果宏很复杂，它还会概述它是如何实现其 objective 的。当我在六个月或十二个月或五年内查看宏观时，这对我有帮助。我有几年前写的宏，快速浏览一下就会知道它是否对今天的问题有帮助。

最后，是宏历史的第一行。每次我更新宏时，我都会添加一两句话说明什么和为什么。

Private Sub NameWS(rootname As String, ws As Worksheet)

  ' Attempt to rename worksheet ws as rootname. If successful, exit.
  ' If unsuccessful, rename worksheet as rootname (N) where
  ' N is the first number in the sequence 1, 2, 3 and so on such
  ' that rootname (N) did not previously exist.

  '  7Nov16  Coded.

  Dim ctr As Long
  Dim NameCrnt As String

  ' Try rootname first
  On Error Resume Next
  ws.Name = rootname
  On Error GoTo 0
  If ws.Name = rootname Then
    ' Rename successful
    Exit Sub
  End If

  ' rootnamne is use. Try rootname (1), rootname(2), etc, until
  ' get successful rename.
  ctr = 1
  Do While True
    NameCrnt = rootname & " (" & ctr & ")"
    On Error Resume Next
    ws.Name = NameCrnt
    On Error GoTo 0
    If ws.Name = NameCrnt Then
      ' Rename successful
      Exit Sub
    End If
    ctr = ctr + 1
  Loop

End Sub

Answer 2

设置问题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

错误处理完成后的奇怪错误行为

Strange error behavior after error handling finished

error-handling

excel

vba

excel-2013