我有一个详细查询的列表框,当在列表框中的一行上双击时,第二个用户窗体打开以允许信息更新,我遇到的问题是应该到达的日期第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
非常感谢任何帮助
谢谢