来自文本框的VBA用户未从工作表填充

时间:2018-11-16 12:00:15

标签: excel vba excel-vba

我有一个详细查询的列表框,当在列表框中的一行上双击时,第二个用户窗体打开以允许信息更新,我遇到的问题是应该到达的日期第13和14列中的内容不会转移回文本框:

.Offset(0, 13).Value, txtnotes.Value, _
.Offset(0, 14).Value, txtdtime.Value)

其他组合框和文本框正在获取正确的数据,但是这些最终的框将不可用。

这是完整的代码:

Private Sub UserForm_Initialize()

'dim the variables
Dim i As Integer
On Error Resume Next
'find the selected list item
i = frmenqnew.lstenq.ListIndex
'add the values to the text boxes
Me.txtenqup.Value = frmenqnew.lstenq.Column(0, i)
Me.txtcustup.Value = frmenqnew.lstenq.Column(1, i)
Me.cboup3.Value = frmenqnew.lstenq.Column(4, i)
Me.cboup4.Value = frmenqnew.lstenq.Column(5, i)
Me.cboup5.Value = frmenqnew.lstenq.Column(6, i)
Me.cboup6.Value = frmenqnew.lstenq.Column(7, i)
Me.txtrev.Value = frmenqnew.lstenq.Column(9, i)
Me.txtnotes.Value = frmenwnew.lstenq.Column(13, i)
Me.txtdtime.Value = frmenwnew.lstenq.Column(14, i)

With cboup5
.AddItem "Active"
.AddItem "Dormant"
.AddItem "Lost"
.AddItem "Sold"
End With

With cboup6
.AddItem "Drawing"
.AddItem "Appraisal"
.AddItem "Verification"
.AddItem "Presenting"
End With

On Error GoTo 0
End Sub
Private Sub cmdUpdate_Click()
' To write edited info of userform2 to Sheets("Data")
    Dim LastRow As Long
    Dim ABnum As Double
    Dim ABrng As Range
    Dim WriteRow As Long

    'error statement
    On Error GoTo errHandler:
    'hold in memory and stop screen flicker
    Application.ScreenUpdating = False
    ' Make sure we're on the right sheet
    With Sheets("Data")
        ' Get the last row used so can set up the search range
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        ' Set the range to search for the AB number
        Set ABrng = .Range("A1:A" & LastRow)
        ' Get the AB number from what is selected on userform2
        ABnum = txtenqup.Value
        ' Get the row of sheet for this AB number
        WriteRow = Application.Match(ABnum, ABrng, 0)
        ' Make this AB number the active cell
        With .Cells(WriteRow, 1)
            'Check for changes

            If Not hasValuePairsChanges(.Offset(0, 4).Value, cboup3.Value, _
                                        .Offset(0, 5).Value, cboup4.Value, _
                                        .Offset(0, 6).Value, cboup5.Value, _
                                        .Offset(0, 7).Value, cboup6.Value, _
                                        CDate(.Offset(0, 8).Value), Date, _
                                        CDbl(.Offset(0, 9).Value), CDbl(txtrev.Value), _
                                        .Offset(0, 13).Value, txtnotes.Value, _
                                        .Offset(0, 14).Value, txtdtime.Value) Then
                MsgBox "No Change in Data", vbInformation, ""
                Exit Sub
            End If

            ' Write in all the editable options

            .Offset(0, 4) = cboup3.Value
            .Offset(0, 5) = cboup4.Value
            .Offset(0, 6) = cboup5.Value
            .Offset(0, 7) = cboup6.Value
            .Offset(0, 8) = Date
            .Offset(0, 9) = txtrev.Value
            .Offset(0, 13) = txtnotes.Value
            .Offset(0, 14) = txtdtime.Value
            Sheets("Archive").Range("A" & Rows.Count).End(xlUp)(2).Resize(, 14).Value = .Resize(, 14).Value
        End With
    End With
    ' Filter the Data
    FilterMe
    ' Close the form
    Unload Me

    MsgBox ("Enquiry E0" + Me.txtenqup.Text + " has been updated")

errHandler:
    'Protect all sheets if error occurs
    'Protect_All
    'show error information in a messagebox
    If Err.Number <> 0 Then
        MsgBox "Error " & Err.Number & " just occured."
    End If

End Sub

Function hasValuePairsChanges(ParamArray Args() As Variant) As Boolean
    Dim n As Long

    For n = 0 To UBound(Args) Step 2
        If Not Args(n) = Args(n + 1) Then
            hasValuePairsChanges = True
            Exit Function
        End If
    Next
End Function

非常感谢任何帮助

谢谢

0 个答案:

没有答案