VBA：删除用户窗体上动态添加的ActiveX元素（已解决）

Question

This线程已有将近4年的历史，但是部分帮助我解决了一个问题。

€：我的代码不起作用的原因是Create-Sub中缺少“ set col_Index = New Collection”语句。因此，我的子确实删除了所有CheckBox，但是再次重新创建了所有这些...

到目前为止，有什么用：在用户窗体中，根据对ComboBox的选择，将创建几个CheckBox并将其链接到自定义类（我需要_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我知道我需要多少个复选框。在我的“演示”中，我跳过了这一部分，并向ComboBox1添加了一些数值（1-6）。 之后，我将col_Index.Count的每个实例更改为ComboBox1.Value

这应该是相同的（至少用于演示），对吗？两者都作为我的“对于我=-循环”的上限。在创建过程中，每个CheckBox都有其自己的名称，这又是我的收藏集（col_Index（i）），而通用名称是i（CheckBox_1； CheckBox_2与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相同的语句-因此，在每次循环后，该项目将从我的集合中删除。 但是在我的“真实”文件中，所有CheckBox都会保留并添加到previos的下面，而在我的“ demo”文件中，_Change（）-Event运行后，所有CheckBox都会被删除。

我缺少什么或做错了什么？

如果有人想尝试演示片段，请随意玩：您只需要一个带有单个工作表和命令按钮的新鲜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。因此，我在第一次调用Delete时使用了一个标志来绕过ComboBox1_Change()。我无意间忘记了第一次通话后重置标志。这让我瞥见了您可能正在经历的事情。导致正确工作的主要修改可能是Set col_Checkbox = New Collection中的行Sub Create。

这是正确运行的代码，希望它与原始代码最接近，并且可以为您提供帮助。

在userform1

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 

在Module1中

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

Class模块未更改。请反馈

Result Image