Excel VBA - 具有 Add/Remove 对象功能的动态用户表单

Question

我正在尝试创建一个用户表单，人们可以在其中提出任意数量的请求，并能够删除他们不再需要的请求以及其他功能。在该序列中使用函数添加-删除-添加后，我在删除动态创建的对象时遇到问题。

我下面的代码包含添加到用户窗体的对象片段以及用户窗体的维度更改和已经嵌入到用户窗体中的对象。下面不包括其他定义的部分。

Dim RemoveButtonArray() As New Class_RemoveRequest

For i = Last To Last
    Set AddRemoveButton = GenPurchaseRequest.Controls.Add("Forms.Image.1", "btnRemove" & ObjID)
    With AddRemoveButton
        'properties
    End With
    Set AddRemoveLabel = GenPurchaseRequest.Controls.Add("Forms.Label.1", "lblRemove" & ObjID)
    With AddRemoveLabel
        'properties
    End With
    Set AddRequest = GenPurchaseRequest.Controls.Add("Forms.Frame.1", "Frame" & ObjID)
    With AddRequest
        'properties
        .Caption = "Purchase Request - " & ObjID
    End With
    With AddRequestButton
        .Top = 168 + (126 * i)
        .Left = 18
    End With
    With SubmitButton
        .Top = 168 + (126 * i)
        .Left = 200
    End With
    With CancelButton
        .Top = 168 + (126 * i)
        .Left = 381
    End With
    With GenPurchaseRequest
        .ScrollHeight = 200 + (126 * i)
        .ScrollTop = 200 + (126 * i)
    End With
ReDim Preserve RemoveButtonArray(0 To i)
Set RemoveButtonArray(i).RemoveButton = AddRemoveButton
Next i

ObjID = ObjID + 1
Last = Last + 1

这很好用，表格中的所有内容都正确填充。当用户删除请求时，以下代码也可以正常工作：

Public WithEvents RemoveButton As MSForms.Image

Private Sub RemoveButton_click()

Dim ConfirmRemoval As Integer
Dim rbRefNo As String
Dim rbRefNoConvert As Integer

ConfirmRemoval = MsgBox("Are you sure you would like to remove this request?", vbYesNo)

If ConfirmRemoval = vbYes Then
rbRefNo = Mid(Me.RemoveButton.Name, 10)
rbRefNoConvert = CInt(rbRefNo)
    With GenPurchaseRequest
        If Last > 1 Then
        .Controls.Remove ("Frame" & rbRefNo)
        .Controls.Remove ("btnRemove" & rbRefNo)
        .Controls.Remove ("lblRemove" & rbRefNo)

            For i = rbRefNoConvert + 1 To Last - 1
            .Controls("Frame" & i).Top = .Controls("Frame" & i).Top - 126
            .Controls("btnRemove" & i).Top = .Controls("btnRemove" & i).Top - 126
            .Controls("lblRemove" & i).Top = .Controls("lblRemove" & i).Top - 126
            Next i

        .AddRequestButton.Top = .AddRequestButton.Top - 126
        .SubmitButton.Top = .SubmitButton.Top - 126
        .CancelButton.Top = .CancelButton.Top - 126
        .ScrollTop = .ScrollTop - 126
        .ScrollHeight = .ScrollHeight - 126

        Last = Last - 1

         Else
         MsgBox "There is only one active Purchase Request."
         End If
     End With
Else
'do nothing
End If

End Sub

然后用户可以返回添加其他请求以及删除他们不再需要的更多请求。当他们添加更多请求，然后尝试删除删除后直接添加的最后一个时，就会出现问题。例如：我添加了 4 个请求，然后删除了第二个请求。然后我添加了另一个请求，但想删除第 4 个请求，但是，删除按钮不再有效。

我认为问题是我需要重新定义用于存储移除按钮的数组，一旦调用移除按钮函数，但我不知道该怎么做。我目前的尝试是：

For j = 0 To Last
If j = rbRefNoConvert Then
j = j + 1
Else
ReDim RemoveButtonArray(0 To j)
Set RemoveButtonArray(j).RemoveButton = AddRemoveButton
End If
Next j

但是那个对象引用不正确，我不知道如何正确引用它。我尝试引用控件本身，但这没有用。

我对 class 模块、数组和动态用户窗体的使用还很陌生，很抱歉这个冗长的问题！

非常感谢任何帮助！

Answer 1

我尝试了几件事：

(1) 将对我要删除的控件的引用设置为数组中的任何内容。

(2) 将控件添加到集合而不是动态数组。

None 以上方法有效，所以我改用最后一种方法。

(3) 我清除了需要删除的控件的文本值。然后，使用 for 循环，我将控件的所有文本值移到上面的帧中我想删除的那些文本值之后。然后，我删除了最后一个控件，重新定义了数组（当用户再次单击按钮以添加另一组控件时），并重新定义了我的计数器。代码如下所示。

Public WithEvents RemoveButton As MSForms.Image

Private Sub RemoveButton_click()

'Defines appropriate variables
Dim ConfirmRemoval As Integer
Dim rbRefNo As String
Dim rbRefNoConvert As Integer

'Asks user for input to remove a control
ConfirmRemoval = MsgBox("Are you sure you would like to remove this request?", vbYesNo)

If ConfirmRemoval = vbYes Then
'Extracts the name identifier from the control to be removed and also converts it into a number
rbRefNo = Mid(Me.RemoveButton.Name, 10)
rbRefNoConvert = CInt(rbRefNo)
With GenPurchaseRequest
    If ObjID > 1 Then
        'Loops through the dynamic form controls and adjusts the user-inputs to account for the removed control
        For i = rbRefNoConvert To ObjID - 1
            If i < (ObjID - 1) Then
                .Controls("txtVendor" & i).Text = .Controls("txtVendor" & i + 1).Text
                .Controls("txtItem" & i).Text = .Controls("txtItem" & i + 1).Text
                .Controls("txtQuantity" & i).Text = .Controls("txtQuantity" & i + 1).Text
                .Controls("txtProject" & i).Value = .Controls("txtProject" & i + 1).Value
                .Controls("txtCatalog" & i).Text = .Controls("txtCatalog" & i + 1).Text
                .Controls("txtDate" & i).Value = .Controls("txtDate" & i + 1).Value
            Else
                .Controls("txtVendor" & i).Text = .Controls("txtVendor" & i).Text
                .Controls("txtItem" & i).Text = .Controls("txtItem" & i).Text
                .Controls("txtQuantity" & i).Text = .Controls("txtQuantity" & i).Text
                .Controls("txtProject" & i).Value = .Controls("txtProject" & i).Value
                .Controls("txtCatalog" & i).Text = .Controls("txtCatalog" & i).Text
                .Controls("txtDate" & i).Value = .Controls("txtDate" & i).Value
            End If
        Next i
        'Removes selected remove button and associated form controls
        .Controls.Remove ("Frame" & ObjID - 1)
        .Controls.Remove ("AddRequestOptions" & ObjID - 1)
        'Re-formats userform to adjust for removed controls
        .AddRequestButton.Top = .AddRequestButton.Top - 126
        .CopyRequestButton.Top = .CopyRequestButton.Top - 126
        .SubmitButton.Top = .SubmitButton.Top - 126
        .CancelButton.Top = .CancelButton.Top - 126
        .ScrollTop = .ScrollTop - 126
        .ScrollHeight = .ScrollHeight - 126
        'Adjusts the object identifier variable to account for removed control
        ObjID = ObjID - 1
    Else
        MsgBox "There is only one active Purchase Request."
    End If
End With
Else
'do nothing
End If

End Sub

Excel VBA - 具有 Add/Remove 对象功能的动态用户表单

Excel VBA - Dynamic Userform with Add/Remove Object Functionality

vba

excel

dynamic-arrays

userform