按下按钮时创建多个文本框时出现错误 400

Posted 2023-02-24

【中文标题】按下按钮时创建多个文本框时出现错误 400

【英文标题】：Having error 400 when creating several textBox when pressing a button

【发布时间】：2020-09-30 11:49:56

【问题描述】：

我有一个包含 2 张工作表的工作簿（一张用于放置数据，另一张用于选项）。 带有数据的那个有一些按钮（在第 1 行）、一些 textBox 和 DropBox（在第 2 行），在第 3 行是表格的标题，下面有所有数据。

目前带有选项的工作表只有一个按钮来重新创建菜单（数据表第 2 行的 TextBox 和 DropBox）

但是，当按下按钮运行宏时，它会给出没有描述的错误 400 和红色 x 信号。有时在重新创建第一个文本框时会出错，有时也会出现第二个或第三个（从不第四个或第五个）。

为什么会发生这样的 400 错误？是什么原因造成的？

在尝试调试代码时，我在某些地方放置了一些 Debug.Print，并在运行 3 次后（单击按钮 3 次后，这是即时窗口中的输出。

-----------Running createMenu-----------
TextBox5 DIM done
TextBox5 Set done
TextBox6 Delete
-----------Running createMenu-----------
TextBox5 Delete
TextBox5 DIM done
TextBox5 Set done
TextBox6 DIM done
TextBox6 Set done
TextBox7 Delete
-----------Running createMenu-----------
TextBox5 Delete

下面的代码（重新创建菜单的代码）放在数据工作表中。

Sub createMenu()
    Debug.Print "-----------Running createMenu-----------"
    Dim wb As Workbook
    Set wb = ThisWorkbook

    Dim ws As Worksheet
    Set ws = wb.Sheets("Dados1")
    With ws
        .Range("A2").NumberFormat = "0"
        .Range("B2").NumberFormat = "dd-mm-yyyy"
        .Range("C2:D2").Merge
        .Range("C2:D2").NumberFormat = "hh:mm:ss"
        Call newTextBox(.Range("E2"))
        Application.Wait (Now + TimeValue("0:00:02"))
        Call newTextBox(.Range("F2"))
        Application.Wait (Now + TimeValue("0:00:02"))
        Call newTextBox(.Range("G2"))
        Application.Wait (Now + TimeValue("0:00:02"))
        Call newTextBox(.Range("H2"))
        Application.Wait (Now + TimeValue("0:00:02"))
        Call newTextBox(.Range("I2"))
        Call newDropBox(.Range("J2"), "=Opções!A1:A14")
        Call newDropBox(.Range("K2"), "=Opções!B1:B2")
        .Range("A2:N2").HorizontalAlignment = xlCenter
    End With
End Sub
Sub newDropBox(t As Range, list As String)
    Dim wb As Workbook
    Set wb = ThisWorkbook

    Dim ws As Worksheet
    Set ws = wb.Sheets("Dados1")
    With ws.Range(t.Address).Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:=list
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
End Sub
Sub newTextBox(t As Range)
    Dim wb As Workbook
    Set wb = ThisWorkbook
    
    Dim ws As Worksheet
    Set ws = wb.Sheets("Dados1")
    With ws
        Dim OLEObj As OLEObjects
        If .OLEObjects.Count > 0 Then
            Dim x As Integer
            For x = 1 To .OLEObjects.Count
                If .OLEObjects(x).Name = "TextBox" & t.Column Then
                    .OLEObjects(x).Delete
                    Debug.Print "TextBox" & t.Column & " Delete"
                End If
            Next x
        End If
        Dim myTextBox As OLEObject
        Debug.Print "TextBox" & t.Column; " DIM done"
        Set myTextBox = .OLEObjects.Add("Forms.TextBox.1")
        Debug.Print "TextBox" & t.Column; " Set done"
        With myTextBox
            .Name = "TextBox" & t.Column
            .LinkedCell = t.Address
            .Left = t.Cells.Left
            .Top = t.Cells.Top
            .Width = t.Cells.Width
            .Height = t.Cells.Height
            .Object.BackColor = 16777152
            .Object.BorderStyle = 1
            .Object.BorderColor = 0
        End With
    End With
End Sub

【参考方案1】：

所以我找出原因... 因此，当我在执行 for 循环时，他首先查找（比如说 2 个 OLEObjects）。 如果在循环的第一个循环中找到了想要的对象，他会删除其中一个对象，使其总 OLEObjects 计数小于 1。 在那里，当循环到第二个 OLEObjects 时，他找不到它，并抛出这样的 400 错误。

所以我所做的修复是在找到目标 OLEObjects 时退出循环。

Sub newTextBox(t As Range)
    Dim wb As Workbook
    Set wb = ThisWorkbook
    
    Dim ws As Worksheet
    Set ws = wb.Sheets("Dados1")
    With ws
        Dim OLEObj As OLEObjects
        If .OLEObjects.Count > 0 Then
            Dim x As Integer
            For x = 1 To .OLEObjects.Count
                If .OLEObjects(x).Name = "TextBox" & t.Column Then
                    .OLEObjects(x).Delete
                    Exit For
                End If
            Next x
        End If
        Dim myTextBox As OLEObject
        Set myTextBox = .OLEObjects.Add("Forms.TextBox.1")
        With myTextBox
            .Name = "TextBox" & t.Column
            .LinkedCell = t.Address
            .Left = t.Cells.Left
            .Top = t.Cells.Top
            .Width = t.Cells.Width
            .Height = t.Cells.Height
            .Object.BackColor = 16777152
            .Object.BorderStyle = 1
            .Object.BorderColor = 0
        End With
    End With
End Sub