Question

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

我下面的代码有一个添加到用户窗体的对象片段，以及用户窗体和已嵌入用户窗体中的对象的尺寸更改。其他定义的部分不包括在下面。

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

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

1 个答案: