Excel VBA - 具有添加/删除对象功能的动态用户表单

Question

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

我下面的代码有一个添加到用户表单的对象的 sn-p，以及用户表单的尺寸更改和已经嵌入用户表单的对象。其他定义的部分不包括在下面。

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 个请求，然后删除了第 2 个。然后我添加了另一个请求，但想删除第 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

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

我对类模块、数组和动态用户表单的使用非常陌生，很抱歉这个冗长的问题！

任何帮助将不胜感激！

Answer 1

我尝试了几件事：

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

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

以上方法都不起作用，所以我使用了最后一种方法。

(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