【发布时间】:2020-09-30 11:49:56
【问题描述】:
我有一个包含 2 张工作表的工作簿(一张用于放置数据,另一张用于选项)。 带有数据的那个有一些按钮(在第 1 行)、一些 textBox 和 DropBox(在第 2 行),在第 3 行是表格的标题,下面有所有数据。
目前带有选项的工作表只有一个按钮来重新创建菜单(数据表第 2 行的 TextBox 和 DropBox)
但是,当按下按钮运行宏时,它会给出没有描述的错误 400 和红色 x 信号。有时在重新创建第一个文本框时会出错,有时也会出现第二个或第三个(从不第四个或第五个)。
在尝试调试代码时,我在某些地方放置了一些 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
【问题讨论】: