时间戳

首页 > 解决方案 > 按下按钮时创建多个文本框时出现错误 400

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

问题描述

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

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

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

为什么会发生这样的 400 错误？是什么原因造成的？ 错误 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

标签： excelvba

解决方案

所以我找出了原因......所以当我做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

推荐阅读