选择表单字段时，使用值更新单元格

Question

我有一本无模式形式的excel工作簿。它的设置方式是：工作簿中的每个工作表在表单中都有一个选项卡。这些标签中的每个字段都链接到相应工作表中的单元格。因此，当在表单中更改/更新值时，它会在相关单元格中自动更新。我这样做的方法是对每个提交的事件都使用onChange事件，该事件是执行更新的UDF。我的问题是，表单中有很多字段，还有很多要添加的字段。选择表单中的字段时，是否有一种方法可以更新相关单元格，而不必为每个字段在onChange事件中添加对UDF的调用？

我尝试使用ControlSource之类的东西，但这只是一种方式，它只会更新表单中的值，而不会在表单更新时更新单元格中的值。

作为旁注，很遗憾，我无法共享表格或表格，但愿意回答任何问题

编辑

下面是更新字段的函数：

Sub UpdateWorksheetValue(ByVal oObj As Object)
    Dim oWS As Worksheet
    Dim sCurrentValue As String
    Dim iC As Long

    ' Lets check if tag is set
    If Len(Trim(oObj.Tag)) = 0 Then
        MsgBox "Empty tag found for '" & oObj.Name & "' field. Failed to update field value" & vbCrLf & vbCrLf & "Please contact system administrator with this information", vbCritical + vbOKOnly, "Update Failed"
        Exit Sub
    ElseIf Len(Trim(Mid(oObj.Tag, InStr(1, oObj.Tag, "¬") + 1))) = 0 Then
        MsgBox "Tag for '" & oObj.Name & "' field does not include page title. Failed to update field value" & vbCrLf & vbCrLf & "Please contact system administrator with this information", vbCritical + vbOKOnly, "Update Failed"
        Exit Sub
    End If

    ' Set worksheet
    Select Case LCase(Trim(Mid(oObj.Tag, InStr(1, oObj.Tag, "¬") + 1)))
        Case "client identification"
            Set oWS = oWB.Worksheets("Client Identification - Output")
        Case "request details"
            Set oWS = oWB.Worksheets("Request Details - Output")
        Case "db responsible individuals"
            Set oWS = oWB.Worksheets("DB Responsible Ind  - Output")
        Case "additional details"
            Set oWS = oWB.Worksheets("Additional Details - Output")

    End Select

    ' Set value
    With oWS

        ' Lets check if tag is set
        If Len(Trim(Mid(oObj.Tag, 1, InStr(1, oObj.Tag, "¬") - 1))) = 0 Then
            MsgBox "Tag for '" & oObj.Name & "' field does not include corresponding cell information. Failed to update field value in '" & oWS.Name & "' worksheet" & vbCrLf & vbCrLf & "Please contact system administrator with this information", vbCritical + vbOKOnly, "Update Failed"
            Exit Sub
        End If

        ' Set the search value
        .Range("Z1").Value = Mid(oObj.Tag, 1, InStr(1, oObj.Tag, "¬") - 1)
        DoEvents

        ' If a row with tag text is not found, throw a message and exit sub
        If Len(Trim(.Range("Z2").Value)) = 0 Then
            MsgBox "Unable to find corresponding cell for '" & oObj.Name & "' field in '" & .Name & "' worksheet. Failed to update field value" & vbCrLf & vbCrLf & "Please ensure that the field's 'Tag' matches a cell in the sheet or contact system administrator", vbCritical + vbOKOnly, "Update Failed"
            Exit Sub
        End If

        ' Set field value
        Select Case LCase(TypeName(oObj))
            Case "textbox", "combobox"
                .Range("B" & .Range("Z2").Value).Value = oObj.Value
            Case "optionbutton"
                If oObj.Value = True Then
                    .Range("B" & .Range("Z2").Value).Value = oObj.Caption
                Else
                    .Range("B" & .Range("Z2").Value).Value = ""
                End If
            Case "listbox"

                ' First lets the current cell value
                sCurrentValue = .Range("B" & .Range("Z2").Value).Value

                ' Now lets build the string for the cell
                For iC = 0 To oObj.ListCount - 1
                    If oObj.Selected(iC) And InStr(1, sCurrentValue, oObj.List(iC)) = 0 Then
                        sCurrentValue = sCurrentValue & "/" & oObj.List(iC)
                    ElseIf Not oObj.Selected(iC) And InStr(1, sCurrentValue, oObj.List(iC)) > 0 Then
                        sCurrentValue = Replace(sCurrentValue, "/" & oObj.List(iC), "")
                    End If
                Next

                ' And finally, set the value
                .Range("B" & .Range("Z2").Value).Value = sCurrentValue

        End Select

    End With

    ' Clear object
    Set oWS = Nothing

End Sub

编辑2
正如David所建议的，我现在有一个名为formEventClass的类。该课程的内容是：

Option Explicit

Public WithEvents tb As MSForms.TextBox
Private Sub tb_Change()
    UpdateWorksheetValue (tb)
End Sub

但是，当我在任何给定的文本框中进行更改时，单元格都不会更新（根据David的建议，我已删除了对文本框UpdateWorksheetValue事件中对onChange的调用。即使我跳出该字段也已更新。因为这适用于David，我怀疑我在这里遗漏了一些东西

Answer 1

如果您想使用WithEvents ...

创建一个类模块并将其命名为tbEventClass。将以下代码放入此模块。

Option Explicit

Public WithEvents tb As MSForms.TextBox
Private Sub tb_Change()
    Call UpdateWorksheetValue(tb)
End Sub

这定义了一个自定义类（tbEventClass），该类响应其tb属性（即TextBox）的事件。在表单的Initialize事件期间，您需要将文本框映射到此类的实例：

Public textbox_handler As New Collection
Private Sub UserForm_Initialize()
Dim ctrl As Control, tbEvent As tbEventClass
For Each ctrl In Me.Controls
    If TypeName(ctrl) = "TextBox" Then
        Set tbEvent = New tbEventClass
        Set tbEvent.tb = ctrl
        textbox_handler.Add tb
    End If
Next

End Sub

重要：您将需要删除或修改Change模块中的UserForm事件处理程序，以避免重复调用“更新”过程。如果这些事件处理程序中唯一发生的事情是对您的更新宏的调用，只需完全删除事件处理程序，它们就可以由tbClass完全代表。如果这些事件包含执行其他工作的其他代码，则只需删除或注释掉调用您的更新函数的行即可。

更新：

这对我来说MultiPage中的控件有用，并且需要对上述实现的代码进行零更改。