VBA：删除用户窗体上动态添加的 ActiveX 元素（在运行时）

Question

This 线程已经快 4 年了，但部分帮助我解决了一个问题。

目前的工作方式：在用户窗体中，根据对组合框的选择，创建了几个复选框并将其链接到自定义类（我需要一个 _Click/_Change-Event）。除了一项缺失的功能外，几乎所有功能都按预期工作：删除复选框如果选择发生变化。

在创建过程中，复选框存储在集合中

    col_Checkbox.Add obj_Checkbox(i), obj_Checkbox(i).Name

如果用户更改了 ComboBox 中的选定值，则触发 _Change() 事件并开始重新创建（取决于新的选择，我可能只需要一个 CheckBox 或三个新的 CheckBox）。 重新创建子从删除 col_Checkbox 的每个项目开始，然后将创建 X 个 CheckBoxes 并链接到自定义类。

花了两天时间研究如何解决这个问题后，我想在这里发布我的问题......现在开始真正奇怪的部分：我已经准备好我的问题，用“复制和粘贴”功能写下代码编辑器中的版本（90% 复制和粘贴，10% 将一些数组（需要数据源）更改为一些硬数字）并考虑在新的 excel 表中快速尝试（你知道，也许我忘了复制一些声明等）。

运行我的代码后（忘记了两个全局语句.. ups），整个事情都按预期工作，令我自己感到惊讶。现在我花了更多时间来寻找差异，看起来我没有发现任何差异除了我已经切换为一些硬数字的缺失数组/集合。

那么，也许有人可以帮助我让我的真实代码像我的“准备发布”代码一样工作？我很高兴它的工作原理，但也对它的工作原理感到困惑。

区别： 我的 ComboBox 充满了几个字符串。选择字符串后，VBA 开始在 column2 中查找匹配的案例，并将所有 colum3 加载到一个数组中（该字符串是我的第一个索引）。在第二步中，将数组添加到集合中，但只有唯一字符串（第二个索引），不会添加重复项。

str_ComboBox1_Selected = ComboBox1.Value
'### Array1
Dim i As Long, j As Long

    For i = 1 To ln_LastRow
        If Cells(i, 2).Value = str_ComboBox1_Selected Then
            ReDim Preserve arr_AllIndex(j)
            arr_AllIndex(j) = Cells(i, 3).Value
            'Debug.Print arr_AllIndex(j)
            j = j + 1
        End If
    Next i
'### Unique-Collection
On Error Resume Next
For Each a In arr_AllIndex
    col_Index.Add a, a
Next
On Error GoTo 0

通过 col_Index.Count 我知道我需要多少个 CheckBox。在我的“演示”中，我跳过了这一部分，并在 ComboBox1 中添加了一些数值 (1-6)。 之后我将 col_Index.Count 的每个实例更改为 ComboBox1.Value

这应该是相同的（至少用于演示），对吧？两者都作为我的“For i =”-Loop 的上限。在创建过程中，每个 CheckBox 都有自己的名称，这又是我的集合 (col_Index(i))，而仅 i 作为通用名称 (CheckBox_1; CheckBox_2 vs. CheckBox_NAME1; CheckBox_NAME2)。

< My Code >
im i As Long
Dim str_ObjName As String

For i = 1 To col_Index.Count
    ReDim Preserve obj_Checkbox(i)

    str_ObjName = "Checkbox_" & col_Index(i)
        Debug.Print col_Index(i)

    Set obj_Checkbox(i) = UserForm1.Controls.Add("Forms.CheckBox.1", str_ObjName)
    col_Checkbox.Add obj_Checkbox(i), obj_Checkbox(i).Name
            'Debug.Print str_ObjName
            'Debug.Print obj_Checkbox(i).Name
            'Debug.Print col_Checkbox.Item(i).Name
Next i

vs 
< My Code without col_Index() and some hard numbers >

Dim i As Long
Dim str_ObjName As String

For i = 1 To UserForm1.ComboBox1.Value

    ReDim Preserve obj_Checkbox(i)

    str_ObjName = "Checkbox_" & i '*Instead of i here would be (collection)(i) to have a proper name

    Set obj_Checkbox(i) = UserForm1.Controls.Add("Forms.CheckBox.1", str_ObjName)
    col_Checkbox.Add obj_Checkbox(i), obj_Checkbox(i).Name  'The created objectes are stored in a collection for later use
        'Debug.Print col_Checkbox.Item(i).Name   'This part works
            'Debug.Print str_ObjName
            'Debug.Print obj_Checkbox(i).Name
            'Debug.Print col_Checkbox.Item(i).Name
Next i

其他一切都是一样的......我尝试使用 debug.print 语句检查某些名称是否不匹配 - 但不，所有三个名称都是相同的（如预期的那样）。

我的删除子是

Dim i As Long
i = 1
Do While col_Checkbox.Count > 0
        'Debug.Print obj_Checkbox(i).Name
        'Debug.Print col_Checkbox.Item(1).Name
    UserForm1.Controls.Remove col_Checkbox.Item(1).Name
        'Debug.Print "i=" & i
    col_Checkbox.Remove 1
    i = i + 1
Loop

End Sub

在这两种情况下（真实和演示），调试语句都显示循环正在按预期工作并计数。 obj_Checkbox(i) 显示与 col_Checkbox.Item(1).Name 相同的语句 - 因此在每个循环之后，该项目都会从我的集合中删除。 但是在我的“真实”文件中，所有复选框都保留并添加到前面的复选框下方，而在我的“演示”文件中，所有复选框都在 _Change()-Event 工作后被删除。

我错过了什么或做错了什么？

如果有人想尝试演示片段，请随意尝试：您只需要一个新的 excel 文件，其中包含一个带有命令按钮的工作表。

对于表 1

Option Explicit

Private Sub CommandButton1_Click()
    UserForm1.Show
End Sub

在通用类模块（Class1）中

Option Explicit

Public WithEvents Class1 As MSForms.CheckBox

Public Sub AssignCheckBox(c As MSForms.CheckBox)
    Set Class1 = c
End Sub

Private Sub Class1_Click()
    Debug.Print Class1.Caption
End Sub

对于通用模块（Module1）

Option Explicit

Global Class1COL As New Collection
Global obj_Checkbox() As Object, col_Checkbox As Collection

Sub Create()
Dim i As Long
Dim str_ObjName As String

For i = 1 To UserForm1.ComboBox1.Value

    ReDim Preserve obj_Checkbox(i)

    str_ObjName = "Checkbox_" & i '*Instead of i here would be (collection)(i) to have a proper name

    Set obj_Checkbox(i) = UserForm1.Controls.Add("Forms.CheckBox.1", str_ObjName)
    col_Checkbox.Add obj_Checkbox(i), obj_Checkbox(i).Name  'The created objectes are stored in a collection for later use
        'Debug.Print col_Checkbox.Item(i).Name   'This part works
            'Debug.Print str_ObjName
            'Debug.Print obj_Checkbox(i).Name
            'Debug.Print col_Checkbox.Item(i).Name
    Select Case True
        Case i = 1
            With obj_Checkbox(1)
                .Top = UserForm1.ComboBox1.Top + 50
            End With
        Case Else
            With obj_Checkbox(i)
                .Top = obj_Checkbox(i - 1).Top + 40
            End With
    End Select

    With obj_Checkbox(i)
        .Left = UserForm1.ComboBox1.Left
        .Height = 35
        .Width = 100
        .Caption = i
    End With

Next i
    Application.OnTime Now, "NewClass"
End Sub

Sub NewClass()
Dim CheckBox As Class1, c As Control
Dim i As Long

    'Debug.Print "new class"
For i = 1 To col_Checkbox.Count
    Set c = col_Checkbox.Item(i)

    Set CheckBox = New Class1
        CheckBox.AssignCheckBox c

        Class1COL.Add CheckBox
Next i
End Sub

Sub Delete()
Dim i As Long
i = 1
Do While col_Checkbox.Count > 0
        'Debug.Print obj_Checkbox(i).Name
        'Debug.Print col_Checkbox.Item(1).Name
    UserForm1.Controls.Remove col_Checkbox.Item(1).Name
        'Debug.Print "i=" & i
    col_Checkbox.Remove 1
    i = i + 1
Loop

End Sub

对于标准用户表单 (UserForm1)

Option Explicit

Sub UserForm_Initialize()
    With UserForm1.ComboBox1
        .AddItem 1
        .AddItem 2
        .AddItem 3
        .AddItem 4
        .AddItem 5
        .AddItem 6
    End With

    With UserForm1
        .Top = Application.Top + 50
        .Left = Application.Left + 100
    End With

    Set col_Checkbox = New Collection

End Sub

Sub ComboBox1_Change()
    Call Module1.Delete
'First every CheckBox on the Form is deleted

'in between an array is created from a list of all search-terms (ComboBox1 doesn't have numbers)//
'// and a unique-only collection is created. With (collection).count I've got the number of CheckBoxes to be created


    Call Module1.Create
'Then X new Boxes will be loaded into the form
End Sub

以防万一有人想看看我的数组到集合例程（也许这里已经有错误了？） 在 ComboBox1_Change 中被调用：

Sub ComboBox1_Change()

    Call Modul1.Delete

str_ComboBox1_Selected = ComboBox1.Value

Dim i As Long, j As Long

    For i = 1 To ln_LastRow
        If Cells(i, 2).Value = str_ComboBox1_Selected Then
            ReDim Preserve arr_AllIndex(j)
            arr_AllIndex(j) = Cells(i, 3).Value
            'Debug.Print arr_AllIndex(j)
            j = j + 1
        End If
    Next i

On Error Resume Next
For Each a In arr_AllIndex
    col_Index.Add a, a
Next
On Error GoTo 0
'For i = 1 To col_Index.Count
    'Debug.Print col_Index(i)
'Next i

    Call Modul1.Create
End Sub

我现在正在处理“测试样本”，因此所有这些通用名称，并非所有引用/变量都被正确声明...在我的测试样本集成到我的“主文件”。

感谢您阅读我的文字墙！

Answer 1

仔细检查您准备的代码以正常工作以进行发布（同时要求minimal-reproducible 代码）并逐渐用您的原始代码替换工作代码是一个真正的考验。使它们与必要的声明和临时数据一起工作。

经过一些小的修改，大概的原始代码可以正常工作。即使在重现原始代码这样的折磨之后，我也无法重现删除错误。但是，我在文件的 Sheet1 的 B 列（随机数 1 到 10）和 C（随机数）中使用了一些临时数字数据。用户表单初始化后，我不得不调用ComboBox1_Change() 事件来填充arr_AllIndex 和col_index。所以我在第一次调用 ComboBox1_Change() 时使用了一个标志来绕过 Delete 。无意中我忘记在第一次通话后重置标志。这以某种方式让我瞥见了您可能正在经历的事情。导致正确工作的主要修改可能是Sub Create 中的Set col_Checkbox = New Collection 行。

这是正确发布的代码，希望它最接近原始代码并以某种方式帮助您。

在用户窗体1中

Option Explicit
Public flag As Boolean
Sub UserForm_Initialize()
    With UserForm1.ComboBox1
        .AddItem 1
        .AddItem 2
        .AddItem 3
        .AddItem 4
        .AddItem 5
        .AddItem 6
        .ListIndex = 2
    End With

    With UserForm1
        .Top = Application.Top + 50
        .Left = Application.Left + 100
    End With

    'Set col_Checkbox = New Collection
    'Set col_Index = New Collection
    flag = False
Call ComboBox1_Change
End Sub
Sub ComboBox1_Change()
If flag Then Call Module1.Delete  'to Bypass delete 1st time after Userform Initialize
flag = True
Dim str_ComboBox1_Selected As Integer
Dim ln_LastRow As Long
Dim Ws As Worksheet, arr_AllIndex() As Variant, a As Variant
str_ComboBox1_Selected = ComboBox1.Value
Set Ws = ThisWorkbook.Sheets("Sheet1")
ln_LastRow = Ws.Cells(Rows.Count, 2).End(xlUp).Row
'Debug.Print str_ComboBox1_Selected


Dim i As Long, j As Long
    For i = 1 To ln_LastRow
        If Cells(i, 2).Value = str_ComboBox1_Selected Then
            ReDim Preserve arr_AllIndex(j)
            arr_AllIndex(j) = Cells(i, 3).Value
            'Debug.Print arr_AllIndex(j)
            j = j + 1
        End If
    Next i

Set col_Index = New Collection
On Error Resume Next
For Each a In arr_AllIndex
    col_Index.Add a, CStr(a)
Next
On Error GoTo 0

'For i = 1 To col_Index.Count
'    Debug.Print "Col Index:" & col_Index(i)
'Next i

 Call Module1.Create
 End Sub 

在模块 1 中

Option Explicit
Global Class1COL As New Collection
Global obj_Checkbox() As Object, col_Checkbox As Collection, col_Index As Collection
Sub Create()
Dim i As Long
Dim str_ObjName As String

Set col_Checkbox = New Collection
For i = 1 To col_Index.Count
    ReDim Preserve obj_Checkbox(i)

    str_ObjName = "Checkbox_" & col_Index(i)
        'Debug.Print col_Index(i)

    Set obj_Checkbox(i) = UserForm1.Controls.Add("Forms.CheckBox.1", str_ObjName)
    col_Checkbox.Add obj_Checkbox(i), obj_Checkbox(i).Name
            'Debug.Print str_ObjName
            'Debug.Print obj_Checkbox(i).Name
            'Debug.Print col_Checkbox.Item(i).Name
     Select Case True
        Case i = 1
            With obj_Checkbox(1)
                .Top = UserForm1.ComboBox1.Top + 50
            End With
        Case Else
            With obj_Checkbox(i)
                .Top = obj_Checkbox(i - 1).Top + 40
            End With
    End Select

    With obj_Checkbox(i)
        .Left = UserForm1.ComboBox1.Left
        .Height = 35
        .Width = 100
        .Caption = str_ObjName
    End With

Next i
NewClass
End Sub
Sub NewClass()
Dim CheckBox As Class1, c As Control
Dim i As Long

    'Debug.Print "new class"
For i = 1 To col_Checkbox.Count
    Set c = col_Checkbox.Item(i)

    Set CheckBox = New Class1
        CheckBox.AssignCheckBox c

        Class1COL.Add CheckBox
Next i
End Sub
Sub Delete()
Dim i As Long
i = 1

Do While col_Checkbox.Count > 0
        'Debug.Print obj_Checkbox(i).Name
        'Debug.Print col_Checkbox.Item(1).Name
    UserForm1.Controls.Remove col_Checkbox.Item(1).Name
        'Debug.Print "i=" & i
    col_Checkbox.Remove 1
    i = i + 1
Loop

End Sub

类模块没有改变。可以请反馈

Result Image