📄 收费管理.frm
字号:
cmdCancel.Enabled = False
cmdAdd.Enabled = True
cmdEdit.Enabled = True
cmdDel.Enabled = True
cmdFirst.Enabled = True
cmdPrev.Enabled = True
cmdNext.Enabled = True
cmdLast.Enabled = True
cmdQuery.Enabled = True
'如果是从添加后取消
If SSTab1.Tab = 0 Then
k = 0
If addw = 1 Then
'如果当前表中有数据则显示第一条数据
If Not rs_wuye.EOF And Not rs_wuye.BOF Then
For i = 0 To 12
Text1(i + k).Text = rs_wuye.Fields(i)
Next i
'如果没有数据，则显示空
Else
For i = 0 To 12
Text1(i + k).Text = ""
Next i
End If
'如果是修改后取消，则恢复到修改前的数据
ElseIf addw = 0 Then
For i = 0 To 12
Text1(i + k).Text = rs_wuye.Fields(i)
Next i
End If
ElseIf SSTab1.Tab = 1 Then
k = 14
If addy = 1 Then
'如果当前表中有数据则显示第一条数据
If Not rs_wuye.EOF And Not rs_wuye.BOF Then
For i = 0 To 12
Text1(i + k).Text = rs_wuye.Fields(i)
Next i
'如果没有数据，则显示空
Else
For i = 0 To 12
Text1(i + k).Text = ""
Next i
End If
'如果是修改后取消，则恢复到修改前的数据
ElseIf addy = 0 Then
For i = 0 To 12
Text1(i + k).Text = rs_wuye.Fields(i)
Next i
End If
End If
'设置各个text框不可写
For i = 0 To 12
Text1(i + k).Enabled = False
Next i
End Sub
Private Sub cmdClose_Click()
Unload Me
End Sub
Private Sub cmdDel_Click()
'当单击删除记录时，需要弹出一个提示框，警告用户
Dim answer As String
answer = MsgBox("确定要删除吗？", vbYesNo, "")
'确实删除
If answer = vbYes Then
rs_wuye.Delete '删除当前记录
rs_wuye.Update '更新删除
MsgBox "成功删除！", vbOKOnly + vbExclamation, ""
Else
Exit Sub
End If
'删除之后，显示总信息条数需要减 1
Text2.Text = Val(Text2.Text) - 1
'删除当前记录后，需要显示下一条记录，如果删除的是最后一条记录，则显示上一条记录
If SSTab1.Tab = 0 Then
'先移动rs_wuye记录到后一条
rs_wuye.MoveNext
If rs_wuye.EOF Then
rs_wuye.MovePrevious
'如果没有到记录首则显示该记录
If Not rs_wuye.BOF Then
For i = 0 To 12
Text1(i).Text = rs_wuye.Fields(i)
Next i
'如果到记录首，则表格已经为空，置所有text框显示为空
ElseIf rs_wuye.BOF Then
For i = 0 To 12
Text1(i).Text = ""
Next i
End If
'如果删除的不是首尾记录，则显示当前记录即可
Else
For i = 0 To 12
Text1(i).Text = rs_wuye.Fields(i)
Next i
End If
ElseIf SSTab1.Tab = 1 Then
'先移动rs_yibiao记录到后一条
rs_yibiao.MoveNext
If rs_yibiao.EOF Then
rs_yibiao.MovePrevious
'如果没有到记录首则显示该记录
If Not rs_yibiao.BOF Then
For i = 14 To 26
Text1(i).Text = rs_yibiao.Fields(i - 14)
Next i
'如果到记录首，则表格已经为空，置所有text框显示为空
ElseIf rs_yibiao.BOF Then
For i = 14 To 26
Text1(i).Text = ""
Next i
End If
'如果删除的不是首尾记录，则显示当前记录即可
Else
For i = 14 To 26
Text1(i).Text = rs_yibiao.Fields(i - 14)
Next i
End If
End If
End Sub
Private Sub cmdEdit_Click()
'设置除保存和取消按钮外的其他按钮不可用
cmdAdd.Enabled = False
cmdEdit.Enabled = False
cmdDel.Enabled = False
cmdSave.Enabled = True
cmdCancel.Enabled = True
cmdFirst.Enabled = False
cmdPrev.Enabled = False
cmdNext.Enabled = False
cmdLast.Enabled = False
cmdQuery.Enabled = False
'需要设置除主键和欠费金额text 框之外的text框可写
If SSTab1.Tab = 0 Then
For i = 1 To 12
Text1(i).Enabled = True
Next i
Text1(9).Enabled = False
'设置addw变量为0
addw = 0
ElseIf SSTab1.Tab = 1 Then
For i = 15 To 26
Text1(i).Enabled = True
Next i
Text1(23).Enabled = False
'设置addy变量为0
addy = 0
End If
End Sub
Private Sub cmdFirst_Click()
'需要设置相应按钮为不可用和不可用
cmdPrev.Enabled = False
cmdFirst.Enabled = False
cmdNext.Enabled = True
cmdLast.Enabled = True
If SSTab1.Tab = 0 Then
'移动rs_wuye记录到第一条
rs_wuye.MoveFirst
'如果已经是第一条记录，则提示用户
If rs_wuye.BOF = True Then
MsgBox "对不起，已经是第一条记录了！", vbOKOnly + vbInformation, "注意"
Exit Sub
'如果不是，则个数据表的记录位置移到第一条记录，并且显示之
Else
For i = 0 To 12
Text1(i).Text = rs_wuye.Fields(i)
Next i
End If
ElseIf SSTab1.Tab = 1 Then
'移动rs_yibiao记录到第一条
rs_yibiao.MoveFirst
'如果已经是第一条记录，则提示用户
If rs_yibiao.BOF = True Then
MsgBox "对不起，已经是第一条记录了！", vbOKOnly + vbInformation, "注意"
Exit Sub
'如果不是，则个数据表的记录位置移到第一条记录，并且显示之
Else
For i = 0 To 12
Text1(i + 14).Text = rs_yibiao.Fields(i)
Next i
End If
End If
End Sub
Private Sub cmdLast_Click()
cmdFirst.Enabled = True
cmdPrev.Enabled = True
cmdNext.Enabled = False
cmdLast.Enabled = False
If SSTab1.Tab = 0 Then
'移动rs_wuye记录到最后一条
rs_wuye.MoveLast
'如果已经是最后一条记录，则提示用户
If rs_wuye.EOF = True Then
MsgBox "对不起，已经是最后一条记录了！", vbOKOnly + vbInformation, "注意"
Exit Sub
'如果不是最后一条，则个数据表的记录位置移到后一条记录，并且显示之
Else
For i = 0 To 12
Text1(i).Text = rs_wuye.Fields(i)
Next i
End If
ElseIf SSTab1.Tab = 1 Then
'移动rs_yibiao记录到最后一条
rs_yibiao.MoveLast
'如果已经是最后一条记录，则提示用户
If rs_yibiao.EOF = True Then
MsgBox "对不起，已经是最后一条记录了！", vbOKOnly + vbInformation, "注意"
Exit Sub
'如果不是最后一条，则个数据表的记录位置移到后一条记录，并且显示之
Else
For i = 0 To 12
Text1(i + 14).Text = rs_yibiao.Fields(i)
Next i
End If
End If
End Sub
Private Sub cmdNext_Click()
'设置前一条和第一条按钮可用
cmdPrev.Enabled = True
cmdFirst.Enabled = True
If SSTab1.Tab = 0 Then
'先移动rs_wuye记录到后一条
rs_wuye.MoveNext
'如果已经是最后一条记录，则提示用户
If rs_wuye.EOF = True Then
MsgBox "对不起，已经是最后一条记录了！", vbOKOnly + vbInformation, "注意"
'并且设置“后一条”和最后一条按钮不可用
cmdNext.Enabled = False
cmdLast.Enabled = False
Exit Sub
'如果不是，则个数据表的记录位置移到后一条记录，并且显示之
Else
For i = 0 To 12
Text1(i).Text = rs_wuye.Fields(i)
Next i
End If
ElseIf SSTab1.Tab = 1 Then
'先移动rs_yibiao记录到后一条
rs_yibiao.MoveNext
'如果已经是最后一条记录，则提示用户
If rs_yibiao.EOF = True Then
MsgBox "对不起，已经是最后一条记录了！", vbOKOnly + vbInformation, "注意"
'并且设置“后一条”和最后一条按钮不可用
cmdNext.Enabled = False
cmdLast.Enabled = False
Exit Sub
'如果不是，则个数据表的记录位置移到后一条记录，并且显示之
Else
For i = 0 To 12
Text1(i + 14).Text = rs_yibiao.Fields(i)
Next i
End If
End If
End Sub
Private Sub cmdPrev_Click()
'设置后一条和最后一条按钮可用
cmdNext.Enabled = True
cmdLast.Enabled = True
If SSTab1.Tab = 0 Then
'先移动rs_wuye记录到前一条
rs_wuye.MovePrevious
'如果已经是第一条记录，则提示用户
If rs_wuye.BOF = True Then
MsgBox "对不起，已经是第一条记录了！", vbOKOnly + vbInformation, "注意"
'并且设置“前一条”和第一条按钮不可用
cmdPrev.Enabled = False
cmdFirst.Enabled = False
Exit Sub
'如果不是，则个数据表的记录位置移到前一条记录，并且显示之
Else
For i = 0 To 12
Text1(i).Text = rs_wuye.Fields(i)
Next i
End If
ElseIf SSTab1.Tab = 1 Then
'先移动rs_yibiao记录到前一条
rs_yibiao.MovePrevious
'如果已经是第一条记录，则提示用户
If rs_yibiao.BOF = True Then
MsgBox "对不起，已经是第一条记录了！", vbOKOnly + vbInformation, "注意"
'并且设置“前一条”和第一条按钮不可用
cmdPrev.Enabled = False
cmdFirst.Enabled = False
Exit Sub
'如果不是，则个数据表的记录位置移到前一条记录，并且显示之
Else
For i = 0 To 12
Text1(i + 14).Text = rs_yibiao.Fields(i)
Next i
End If
End If
End Sub
Private Sub cmdQuery_Click()
frmQueryFee.Show
End Sub
Private Sub cmdSave_Click()
'使用 k 变量简化代码
If SSTab1.Tab = 0 Then
k = 0
ElseIf SSTab1.Tab = 1 Then
k = 14
End If
'设置交费日期为当前日期
Text1(10 + k).Text = Date
'欠费金额通过计算得到
Text1(9 + k).Text = Val(Text1(7 + k).Text) - Val(Text1(8 + k).Text)
'检测数据是否完整
If Text1(0 + k).Text = "" Then
MsgBox "收费编号不可为空！", vbOKOnly + vbInformation, "注意"
Text1(0 + k).SetFocus
Exit Sub
ElseIf Text1(1 + k).Text = "" Then
MsgBox "住户姓名不可为空！", vbOKOnly + vbInformation, "注意"
Text1(1 + k).SetFocus
Exit Sub
ElseIf Not (Val(Text1(3 + k).Text) < 3000 And Val(Text1(3 + k).Text) > 1900) Then
MsgBox "年份输入不正确！", vbOKOnly + vbInformation, "注意"
Text1(3 + k).SetFocus
Exit Sub
ElseIf Not (Val(Text1(4 + k).Text) >= 1 And Val(Text1(4 + k).Text) <= 12) Then
MsgBox "月份书写不对，应为1－12的数字！", vbOKOnly + vbInformation, "注意"
Text1(4 + k).SetFocus
Exit Sub
ElseIf Text1(5 + k).Text = "" Then
MsgBox "收费项目不可为空！", vbOKOnly + vbInformation, "注意"
Text1(5 + k).SetFocus
Exit Sub
ElseIf Text1(6 + k).Text = "" Then
MsgBox "收费方式不可为空！", vbOKOnly + vbInformation, "注意"
Text1(6 + k).SetFocus
Exit Sub
ElseIf IsNumeric(Text1(7 + k).Text) = False Then
MsgBox "应收总额必须为数字！", vbOKOnly + vbInformation, "注意"
Text1(7 + k).SetFocus
Exit Sub
ElseIf IsNumeric(Text1(8 + k).Text) = False Then
MsgBox "已交金额必须为数字！", vbOKOnly + vbInformation, "注意"
Text1(8 + k).SetFocus
Exit Sub
ElseIf IsDate(Text1(10 + k).Text) = False Then
MsgBox "交费日期必须为这样的日期格式2003-7-25！", vbOKOnly + vbInformation, "注意"
Text1(10 + k).SetFocus
Exit Sub
ElseIf Text1(11 + k).Text = "" Then
MsgBox "办理人不可为空！", vbOKOnly + vbInformation, "注意"
Text1(11 + k).SetFocus
Exit Sub
End If
'2个选项卡的保存代码
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -