选择表单字段时，使用值更新单元格 [英] Update cell with a value when form field is selected

问题描述

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

I have an excel workbook with modeless form. The way it's setup is that: each sheet in the workbook has a tab in the form. Each field in these tabs is Linked to a cell in corresponding sheet. So when a value is changed/updated in the form, it is automatically updated in the relevant cell. The way I am doing this is by using the onChange event for each filed which call's a UDF that does the updating. My question, there are a lot of fields in the form and lots more to be added. Is there a way to update relevant cell when a field in the form is selected without having to add the call to a UDF in onChange event for each field?

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

I have tried using things like ControlSource but that only one way where it just updates the value in the form but doesn't update the value in the cell when form is updated.

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

As a side note, unfortunately I cannot share the form or the sheet but am willing to answer any questions

编辑

下面是更新字段的函数:

Below is the function that updates the field:

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的类.该课程的内容是:

EDIT 2
I now have a class called formEventClass as suggested by David. Contents of the class are:

Option Explicit

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

但是，当我在任何给定的文本框中进行更改时，单元格都不会更新(根据David的建议，我已删除了对文本框onChange事件中对UpdateWorksheetValue的调用.即使在我标签，因为它正在为David工作，我怀疑我在这里遗漏了一些东西

But when I make a change in any given text box, cells are not updated (as per David's suggestion, I've removed the call to UpdateWorksheetValue in text box onChange event. Cells are not updated even when I tab out of the field. As this is working for David, I suspect I am missing something here

推荐答案

如果您想使用WithEvents ...

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

If you want to get fancy using WithEvents...

Create a Class Module and name it tbEventClass. Put the following code in this module.

Option Explicit

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

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

This defines a custom class (tbEventClass) which is responsive to the events of it's tb property which is a TextBox. You'll need to map your textboxes to instances of this class during the form's Initialize event:

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

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

Important: You will either need to remove or modify the Change event handlers in the UserForm module to avoid duplicate calls to the "update" procedure. If the only thing going on in those event handlers is the call to your update macro, just get remove the event handlers entirely, they're fully represented by the tbClass. If those events contain other code that does other stuff, just remove or comment out the line(s) that call on your update function.

这对于我使用MultiPage中的控件是有效的，并且要求对上述已实现的代码进行零更改.

This is working for me with the controls within a MultiPage and required ZERO changes to the implemented code above.

这篇关于选择表单字段时，使用值更新单元格的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！