我有这个Excel用户窗体，它允许您添加，查看下一个/上一个和第一个/最后一个记录，以及在用户窗体中搜索记录。
在搜索和更新特定记录后，保存记录时出现问题。
UserForm在下面具有以下VBA代码。
Private Sub btnClose_Click()
Me.Hide
End Sub
Private Sub btnFirst_Click()
FirstRecord
End Sub
Private Sub btnLast_Click()
Last Record
End Sub
Private Sub btnNew_Click()
NewRecord
End Sub
Private Sub btnNext_Click()
NextRecord
End Sub
Private Sub btnPrevious_Click()
PreviousRecord
End Sub
Private Sub btnSaveRecord_Click()
SaveRecord (RowNumber)
End Sub
'Private Sub cmdUpdateRec_Click()
' EditRecord (RowNumber)
'End Sub
Private Sub SearchMemberID_Click()
SearchMemID
End Sub
Private Sub SearchMember_Click()
SearchMem
End Sub
Private Sub userform_initialize()
Dim strShtNameMenu As String
strShtNameMenu = "Menu Options"
Me.CBxCompUpheld.List = Sheets(strShtNameMenu).Range("Complaint_Upheld").Value
Me.CBxIssueResolved.List = Sheets(strShtNameMenu).Range("Issue_Resolved").Value
Me.CBxMemberSatisfied.List = Sheets(strShtNameMenu).Range("Member_Satisfied").Value
Me.CBxCompAgainst.List = Sheets(strShtNameMenu).Range("Complaint_Against").Value
Me.CBxDept.List = Sheets(strShtNameMenu).Range("Department").Value
'Me.CBxOwner.List = Sheets(strShtNameMenu).Range("Owner").Value
Me.CBxMember.List = Sheets(strShtNameMenu).Range("Member").Value
ShowRecord (3)
End Sub
这些CommandButton从下面的模块中调用宏。
Public shtNameLog As String
Public shtNameMenu As String
Public frmNameComplaints As String
Public RowNumber As Integer 'current row
'Dim RowNumber As Long
Public intLastRow As Integer 'last row
Public RecordRefNmbr As Integer
Dim strSrch As String
'''' First Record ''''
Sub FirstRecord()
Dim RecordRefNmbr
RecordRefNmbr = 3
ShowRecord (RecordRefNmbr)
End Sub
'''' Last Record ''''
Sub LastRecord()
Dim RecordRefNmbr
Sheets("Log").Select
RecordRefNmbr = Range("B" & Rows.Count).End(xlUp).Row
ShowRecord (RecordRefNmbr)
End Sub
'''' New Record ''''
Sub NewRecord()
Sheets("Log").Select
intLastRow = Range("B" & Rows.Count).End(xlUp).Row
ShowRecord (intLastRow + 1)
End Sub
'''' Next Record ''''
Sub NextRecord()
Sheet1.Select
intLastRow = Sheet1.Range("B" & Rows.Count).End(xlUp).Row
If RowNumber = intLastRow Then
MsgBox "This is the last complaint record.", vbOKOnly, "Last Record reached"
Else
ShowRecord (RowNumber + 1)
End If
End Sub
'''' Previous Record ''''
Sub PreviousRecord()
If RowNumber = 3 Then
ShowRecord (RowNumber)
MsgBox "This is the first complaint record.", vbOKOnly, "First Record reached"
Else
ShowRecord (RowNumber - 1)
End If
End Sub
'''' Membership ID Search ''''
Sub SearchMemID()
Dim TBrow As Long
Dim BV As String ', strSrch As String
Dim RecordNmbr As Integer
Dim strFormName As String
' Dim txtDateRaised As Date 'String
' Dim txtMemberID As String
' Dim txtName As String
' Dim txtCompAgainst As String
' Dim txtCompCategory As String
' Dim txtDept As String
' Dim txtInitialAdvisor As String
' Dim txtOwner As String
' Dim txtBriefDesc As String
' Dim txtFindings As String
' Dim txtOutcome As String
' Dim txtActions As String
' Dim txtComplaintUpheld As String
' Dim txtFollowUpDate As Date 'String
' Dim txtIssueResolved As String
' Dim txtMemberSatisfied As String
' Dim txtDateClosed As Date 'String
shtNameLog = "Log"
strFormName = "frmNameComplaints"
'RecordNmbr = RecordRefNmbr
'RecordRefNmbr = RecordNmbr
RowNumber = RecordNmbr
strSrch = ComplaintsLog.TextBox2.Value
Set TB = Sheets(shtNameLog).Range("D:D").Find(what:=strSrch, lookat:=xlPart)
If Not TB Is Nothing Then
RecordNmbr = TB.Row
With ComplaintsLog
.txtDateRaised.Value = Sheets(shtNameLog).Cells(RecordNmbr, 2).Value
.CBxMember.Value = Sheets(shtNameLog).Cells(RecordNmbr, 3).Value
.txtMemberID.Value = Sheets(shtNameLog).Cells(RecordNmbr, 4).Value
.txtName.Value = Sheets(shtNameLog).Cells(RecordNmbr, 5).Value
.CBxCompAgainst.Value = Sheets(shtNameLog).Cells(RecordNmbr, 6).Value
.txtCompCategory.Value = Sheets(shtNameLog).Cells(RecordNmbr, 7).Value
.CBxDept.Value = Sheets(shtNameLog).Cells(RecordNmbr, 8).Value
.txtInitialAdvisor.Value = Sheets(shtNameLog).Cells(RecordNmbr, 11).Value
.txtOwner.Value = Sheets(shtNameLog).Cells(RecordNmbr, 12).Value
.txtBriefDesc.Value = Sheets(shtNameLog).Cells(RecordNmbr, 9).Value
.txtFindings.Value = Sheets(shtNameLog).Cells(RecordNmbr, 10).Value
.txtOutcome.Value = Sheets(shtNameLog).Cells(RecordNmbr, 16).Value
.txtActions.Value = Sheets(shtNameLog).Cells(RecordNmbr, 17).Value
.CBxCompUpheld.Value = Sheets(shtNameLog).Cells(RecordNmbr, 13).Value
.txtFollowUpDate.Value = Sheets(shtNameLog).Cells(RecordNmbr, 14).Value
.CBxIssueResolved.Value = Sheets(shtNameLog).Cells(RecordNmbr, 15).Value
.CBxMemberSatisfied.Value = Sheets(shtNameLog).Cells(RecordNmbr, 18).Value
.txtDateClosed.Value = Sheets(shtNameLog).Cells(RecordNmbr, 19).Value
End With
Else
MsgBox "Error, Value Not Found!"
End
End If
BV = Cells(RecordNmbr, 2).Value
End Sub
'''' Customer/ Member Search ''''
Sub SearchMem()
'Dim TB As Range
Dim TBrow As Long
Dim BV As String ', strSrch As String
Dim strFormName As String
' Dim txtDateRaised As Date 'String
' Dim txtMemberID As String
' Dim txtName As String
' Dim txtCompAgainst As String
' Dim txtCompCategory As String
' Dim txtDept As String
' Dim txtInitialAdvisor As String
' Dim txtOwner As String
' Dim txtBriefDesc As String
' Dim txtFindings As String
' Dim txtOutcome As String
' Dim txtActions As String
' Dim txtComplaintUpheld As String
' Dim txtFollowUpDate As Date 'String
' Dim txtIssueResolved As String
' Dim txtMemberSatisfied As String
' Dim txtDateClosed As Date 'String
Dim RecordNmbr As Integer
shtNameLog = "Log"
strFormName = "frmNameComplaints"
RecordNmbr = RecordRefNmbr
RowNumber = RecordNmbr
strSrch = ComplaintsLog.TextBox1.Value
Set TB = Sheets(shtNameLog).Range("E:E").Find(what:=strSrch, lookat:=xlPart)
If Not TB Is Nothing Then
RecordNmbr = TB.Row
With ComplaintsLog
.txtDateRaised.Value = Sheets(shtNameLog).Cells(RecordNmbr, 2).Value
.CBxMember.Value = Sheets(shtNameLog).Cells(RecordNmbr, 3).Value
.txtMemberID.Value = Sheets(shtNameLog).Cells(RecordNmbr, 4).Value
.txtName.Value = Sheets(shtNameLog).Cells(RecordNmbr, 5).Value
.CBxCompAgainst.Value = Sheets(shtNameLog).Cells(RecordNmbr, 6).Value
.txtCompCategory.Value = Sheets(shtNameLog).Cells(RecordNmbr, 7).Value
.CBxDept.Value = Sheets(shtNameLog).Cells(RecordNmbr, 8).Value
.txtInitialAdvisor.Value = Sheets(shtNameLog).Cells(RecordNmbr, 11).Value
.txtOwner.Value = Sheets(shtNameLog).Cells(RecordNmbr, 12).Value
.txtBriefDesc.Value = Sheets(shtNameLog).Cells(RecordNmbr, 9).Value
.txtFindings.Value = Sheets(shtNameLog).Cells(RecordNmbr, 10).Value
.txtOutcome.Value = Sheets(shtNameLog).Cells(RecordNmbr, 16).Value
.txtActions.Value = Sheets(shtNameLog).Cells(RecordNmbr, 17).Value
.CBxCompUpheld.Value = Sheets(shtNameLog).Cells(RecordNmbr, 13).Value
.txtFollowUpDate.Value = Sheets(shtNameLog).Cells(RecordNmbr, 14).Value
.CBxIssueResolved.Value = Sheets(shtNameLog).Cells(RecordNmbr, 15).Value
.CBxMemberSatisfied.Value = Sheets(shtNameLog).Cells(RecordNmbr, 18).Value
.txtDateClosed.Value = Sheets(shtNameLog).Cells(RecordNmbr, 19).Value
End With
Else
MsgBox "Error, Value Not Found!"
End
End If
BV = Cells(RecordNmbr, 2).Value
End Sub
'''' Show Record ''''
Sub ShowRecord(RecordRefNmbr)
Dim RecordNmbr As Integer
Dim strFormName As String
Dim txtDateRaised As Date 'String
Dim txtMemberID As String
Dim txtName As String
Dim txtCompAgainst As String
Dim txtCompCategory As String
Dim txtDept As String
Dim txtInitialAdvisor As String
Dim txtOwner As String
Dim txtBriefDesc As String
Dim txtFindings As String
Dim txtOutcome As String
Dim txtActions As String
Dim txtComplaintUpheld As String
Dim txtFollowUpDate As Date 'String
Dim txtIssueResolved As String
Dim txtMemberSatisfied As String
Dim txtDateClosed As Date 'String
shtNameLog = "Log"
strFormName = "frmNameComplaints"
RecordNmbr = RecordRefNmbr
RowNumber = RecordNmbr
With ComplaintsLog
.txtDateRaised.Value = Sheets(shtNameLog).Cells(RecordNmbr, 2).Value
.CBxMember.Value = Sheets(shtNameLog).Cells(RecordNmbr, 3).Value
.txtMemberID.Value = Sheets(shtNameLog).Cells(RecordNmbr, 4).Value
.txtName.Value = Sheets(shtNameLog).Cells(RecordNmbr, 5).Value
.CBxCompAgainst.Value = Sheets(shtNameLog).Cells(RecordNmbr, 6).Value
.txtCompCategory.Value = Sheets(shtNameLog).Cells(RecordNmbr, 7).Value
.CBxDept.Value = Sheets(shtNameLog).Cells(RecordNmbr, 8).Value
.txtInitialAdvisor.Value = Sheets(shtNameLog).Cells(RecordNmbr, 11).Value
.txtOwner.Value = Sheets(shtNameLog).Cells(RecordNmbr, 12).Value
.txtBriefDesc.Value = Sheets(shtNameLog).Cells(RecordNmbr, 9).Value
.txtFindings.Value = Sheets(shtNameLog).Cells(RecordNmbr, 10).Value
.txtOutcome.Value = Sheets(shtNameLog).Cells(RecordNmbr, 16).Value
.txtActions.Value = Sheets(shtNameLog).Cells(RecordNmbr, 17).Value
.CBxCompUpheld.Value = Sheets(shtNameLog).Cells(RecordNmbr, 13).Value
.txtFollowUpDate.Value = Sheets(shtNameLog).Cells(RecordNmbr, 14).Value
.CBxIssueResolved.Value = Sheets(shtNameLog).Cells(RecordNmbr, 15).Value
.CBxMemberSatisfied.Value = Sheets(shtNameLog).Cells(RecordNmbr, 18).Value
.txtDateClosed.Value = Sheets(shtNameLog).Cells(RecordNmbr, 19).Value
End With
End Sub
'''' Save Record ''''
Sub SaveRecord(RecordRefNmbr)
'
'Dim TBrow As Long
'Dim BV As String, strSrch As String
'Dim txtDateRaised As Date 'String
'Dim txtMemberID As String
'Dim txtName As String
'Dim txtCompAgainst As String
'Dim txtCompCategory As String
'Dim txtDept As String
'Dim txtInitialAdvisor As String
'Dim txtOwner As String
'Dim txtBriefDesc As String
'Dim txtFindings As String
'Dim txtOutcome As String
'Dim txtActions As String
'Dim txtComplaintUpheld As String
'Dim txtFollowUpDate As Date 'String
'Dim txtIssueResolved As String
'Dim txtMemberSatisfied As String
'Dim txtDateClosed As Date 'String
Dim shtNameLog As String
Dim strFormName As String
Dim RecordNmbr As Integer
Dim RowNumber As String
shtNameLog = "Log"
strFormName = "frmNameComplaints"
RecordNmbr = RecordRefNmbr
'RowNumber = RecordNmbr
'RowNumber = RecordRefNmbr
With ComplaintsLog
If Not IsDate(.txtDateRaised.Value) Then
MsgBox "Date Raised must be entered in format 'DD/MM/YYYY' "
Else
Sheets(shtNameLog).Cells(RecordNmbr, 2).Value = DateValue(Format(.txtDateRaised.Value,
"DD/MM/YYYY"))
End If
Sheets(shtNameLog).Cells(RecordNmbr, 3).Value = .CBxMember.Value
Sheets(shtNameLog).Cells(RecordNmbr, 4).Value = .txtMemberID.Value
Sheets(shtNameLog).Cells(RecordNmbr, 5).Value = .txtName.Value
Sheets(shtNameLog).Cells(RecordNmbr, 6).Value = .CBxCompAgainst.Value
Sheets(shtNameLog).Cells(RecordNmbr, 7).Value = .txtCompCategory.Value
Sheets(shtNameLog).Cells(RecordNmbr, 8).Value = .CBxDept.Value
Sheets(shtNameLog).Cells(RecordNmbr, 11).Value = .txtInitialAdvisor.Value
Sheets(shtNameLog).Cells(RecordNmbr, 12).Value = .txtOwner.Value
Sheets(shtNameLog).Cells(RecordNmbr, 9).Value = Replace(.txtBriefDesc.Value, Chr(10), " ")
Sheets(shtNameLog).Cells(RecordNmbr, 10).Value = Replace(.txtFindings.Value, Chr(10), " ")
Sheets(shtNameLog).Cells(RecordNmbr, 16).Value = Replace(.txtOutcome.Value, Chr(10), " ")
Sheets(shtNameLog).Cells(RecordNmbr, 17).Value = Replace(.txtActions.Value, Chr(10), " ")
Sheets(shtNameLog).Cells(RecordNmbr, 13).Value = .CBxCompUpheld.Value
If .txtFollowUpDate.Value = "" Then
Else
If Not IsDate(.txtFollowUpDate.Value) Then
MsgBox "Follow Up Date must be entered in format 'DD/MM/YYYY' "
Else
Sheets(shtNameLog).Cells(RecordNmbr, 14).Value =
DateValue(Format(.txtFollowUpDate.Value, "DD/MM/YYYY"))
End If
End If
Sheets(shtNameLog).Cells(RecordNmbr, 15).Value = .CBxIssueResolved.Value
Sheets(shtNameLog).Cells(RecordNmbr, 18).Value = .CBxMemberSatisfied.Value
If .txtDateClosed.Value = "" Then
Else
If Not IsDate(.txtDateClosed.Text) Then
MsgBox "Date Closed must be entered in format 'DD/MM/YYYY' "
Else
Sheets(shtNameLog).Cells(RecordNmbr, 19).Value =
DateValue(Format(.txtDateClosed.Value, "DD/MM/YYYY"))
End If
End If
End With
MsgBox "Record Saved"
End Sub
使用当前编码，当我尝试更新搜索的记录时，消息错误
“运行时错误1004应用程序定义的错误或对象定义的错误”。
在线
Sheets(shtNameLog).Cells(RecordNmbr, 2).Value = DateValue(Format(.txtDateRaised.Value, "DD/MM/YYYY"))
我确实继承了此文件/代码，所以我是VBA的初学者，所以任何帮助都将很有用。如果可以采用其他/更简单的方法，我欢迎您提出建议。
