循环选择用户窗体控件以在工作表中打印值

Question

新更新 - 使用集合映射用户窗体控件的目标

使用集合来引用用户窗体控件和输入位置

我创建了一个集合，如下所示，以将打印用户窗体控件的位置引用到工作表。我在工作表“Sheet1”上对此进行了测试，控件为“subTaskID”和“TextBoxsubtask”。

我得到一个

"ByRef 参数类型不匹配"

在 ctlMap 变量上。我试图按照下面 PeterT 的解释进行操作。

'' COLLECTION START DELETE FROM HERE IF WRONG
Sub Userform_Intialize()

Set ctlMap = New Collection
With ctlMap
    .Add item = "Sheet1!B1", key:="SubTaskID"
    .Add item = "Sheet!B2", key:="TextBoxsubtask"
End With

End Sub 

'Macro to populate sheet

Private Sub CommandButton1_Click()

    Dim ctl As Variant
    For Each ctl In Me.Controls
        If ControlExists(ctlMap, ctl.Name) Then
            Range(ctlMap(ctl.Name)) = ctl.Value
        End If
    Next ctl

End Sub

原始问题

我有一个用户表单来填充有关项目任务的 Excel 文件。

我创建了将每个控件链接到正确列和单元格编号的代码。我想提高我的代码效率以加快速度。我不希望输入标签和某些文本框值，并且如果控件为空白则跳到下一个。

我无法通过控件正确排序循环，因为它没有打印在所需的单元格中。

如何重新排列此订单？还有如何防止它为空值打印 false？

我创建了一个包含所需控件名称的数组，但出现错误

运行时需要相同的对象。

lastrowST = subtaskws.range("A" & Rows.Count).End(xlUp).row

Dim Ctrl As Control, col As Long, range As range, userformorder As Variant

With AddTask
userformorder = Array(.SubTaskID, .TextBoxsubtask, .ComboBoxDeliverableFormat, .TextBoxcheckedcomplete, .TextBoxformat, .TextBoxacceptancecriteria, .BudgetWorkloadTextBox, .AWLTextBox, .ComboBoxOwner, .TextBoxTDSNumber, .TextBoxMilestone, .TextBoxTargetDeliveryDate, .ComboBoxW, .ComboBoxI, .ComboBoxe, .TextBoxP, .TextBoxLevel, .TextBoxInputQuality, .TextBoxNewInput, .TextBoxDelay, .TextBoxInternalVV, .TextBoxReviewer, .TextBoxDelivered, .ComboBoxNumIterations, .ComboBoxAcceptance, .ComboBoxProgress, .ComboBoxStatus, .ComboBoxFlowChart, .TextBoxActivitySheet, .TextBoxEvidenceofDelivery, .TextBoxComments)

For Each range In subtaskws.range("A" & lastrowST + 1 & ":AE" & lastrowST + 1 & "")
    For Each Ctrl.Value In userformorder
        If Ctrl.Value <> "" Then
            range.Value = Ctrl.Value
        Else
        End If
    Next Ctrl
Next range
End With

Answer 1

我经常使用的一种方法是在控件和单元格之间创建映射。我为此使用Collection 并在Initialize 事件中设置地图：

Private Sub UserForm_Initialize()
    Set ctlMap = New Collection
    With ctlMap
        .Add Item:="Sheet1!B1", key:="TextBox1"
        .Add Item:="Sheet1!B2", key:="TextBox2"
        .Add Item:="Sheet1!B3", key:="CheckBox1"
    End With
End Sub

我的用户表单看起来像这样

工作表上的数据如下所示

所以现在要填充控件，它只是一个循环遍历用户窗体上的所有控件。因为我们使用的是控件映射，所以只填充了映射的控件。 Select 语句是必要的，因为并非所有控件都具有相同的属性来访问数据。例如，TextBox 使用 ctl.Text，而 CheckBox 使用 ctl.Value。

编辑：我的记忆有问题，我提到了我的一些旧代码 例如。 This answer 很好地解释了你为什么 想要使用.Value 来访问控件的值。这表示 您可能可以删除 Select 语句并替换所有 用一个简单的ctl.Value = Range(ctlMap(ctl.Name)) 来照顾 所有作业。以防万一开发人员想要执行 具体逻辑基于控件，我留下Select语句 完好无损。

Private Sub PopulateControls()
    Dim ctl As Variant
    For Each ctl In Me.Controls
        If ControlExists(ctlMap, ctl.Name) Then
            Select Case TypeName(ctl)
                Case "TextBox"
                    ctl.Text = Range(ctlMap(ctl.Name))

                Case "CheckBox"
                    ctl.Value = Range(ctlMap(ctl.Name))

            End Select
        End If
    Next ctl
End Sub

或可选

Private Sub PopulateControls()
    Dim ctl As Variant
    For Each ctl In Me.Controls
        If ControlExists(ctlMap, ctl.Name) Then
            ctl.Value = Range(ctlMap(ctl.Name))
        End If
    Next ctl
End Sub

Private Sub ControlsToWorksheet()
    Dim ctl As Variant
    For Each ctl In Me.Controls
        If ControlExists(ctlMap, ctl.Name) Then
            Range(ctlMap(ctl.Name)) = ctl.Value
        End If
    Next ctl
End Sub

用户表单的完整代码如下

Option Explicit

Private ctlMap As Collection

Private Sub PopulateControls()
    Dim ctl As Variant
    For Each ctl In Me.Controls
        If ControlExists(ctlMap, ctl.Name) Then
            Select Case TypeName(ctl)
                Case "TextBox"
                    ctl.Text = Range(ctlMap(ctl.Name))

                Case "CheckBox"
                    ctl.Value = Range(ctlMap(ctl.Name))

            End Select
        End If
    Next ctl
End Sub

Private Sub ControlsToWorksheet()
    Dim ctl As Variant
    For Each ctl In Me.Controls
        If ControlExists(ctlMap, ctl.Name) Then
            Select Case TypeName(ctl)
                Case "TextBox"
                    Range(ctlMap(ctl.Name)) = ctl.Text

                Case "CheckBox"
                    Range(ctlMap(ctl.Name)) = ctl.Value

            End Select
        End If
    Next ctl
End Sub

Private Function ControlExists(ByRef thisCollection As Collection, _
                               ByVal key As String) As Boolean
    On Error GoTo SKIP
    ctlMap.Item key
    ControlExists = True
SKIP:
End Function

Private Sub CloseButton_Click()
    Me.Hide
End Sub

Private Sub PopulateButton_Click()
    PopulateControls
End Sub

Private Sub WriteButton_Click()
    ControlsToWorksheet
End Sub

Private Sub UserForm_Initialize()
    Set ctlMap = New Collection
    With ctlMap
        .Add Item:="Sheet1!B1", key:="TextBox1"
        .Add Item:="Sheet1!B2", key:="TextBox2"
        .Add Item:="Sheet1!B3", key:="CheckBox1"
    End With
End Sub

Answer 2

我认为这会满足您的需求。彼得的回答中有一些值得细读的好东西。

lastrowST = subtaskws.range("A" & Rows.Count).End(xlUp).Row

Dim Ctrl As Variant, range1 As range, userformorder As Variant, col As Long

userformorder = Array("SubTaskID", "TextBoxsubtask", "ComboBoxDeliverableFormat", "TextBoxcheckedcomplete") 'etc

For Each Ctrl In userformorder
    If AddTask.Controls(Ctrl).Value <> "" Then
        subtaskws.range("A" & lastrowST + 1).Offset(, col).Value = AddTask.Controls(Ctrl).Value
    End If
    col = col + 1
Next Ctrl

End With