房屋租赁管理系统源代码.docx

系统主界面的设计启动系统后，主界面设计效果图如下: 公用模块的设计代码分析如下:Option ExplicitPublic conn As New ADODB.Connection'定义全局变量queryhouse 作为判断frmHouse 窗体显示查询的数据还是全体数据Public queryhouse As Boolean'定义全局变量sqlqh 作为查询房屋信息时的sql语句Public sqlqh As String'定义全局变量querycf 作为判断frmClient 窗体家庭租户选项卡显示查询的数据还是全体数据Public querycf As Boolean'定义全局变量sqlqcf 作为查询家庭租户信息时的sql语句Public sqlqcf As String'定义全局变量querycg 作为判断frmClient 窗体家公司户选项卡显示查询的数据还是全体数据Public querycg As Boolean'定义全局变量sqlqcg 作为查询公司租户信息时的sql语句Public sqlqcg As String'定义全局变量queryemp 作为判断frmEmp 窗体显示查询的数据还是全体数据Public queryemp As Boolean'定义全局变量sqlqe 作为查询员工信息时的sql语句Public sqlqe As String'定义全局变量queryqzc 作为判断frmQZClient 窗体显示查询的数据还是全体数据Public queryqzc As Boolean'定义全局变量sqlqzc 作为查询求租客户信息时的sql语句Public sqlqzc As String'定义全局变量querycon 作为判断frmAdminContract 窗体显示查询的数据还是全体数据Public querycon As Boolean'定义全局变量sqlqcon 作为查询合同信息时的sql语句Public sqlqcon As String'定义全局变量sqlqyd 作为查询预定单信息时的sql语句Public sqlqyd As String'定义全局变量fromqzc 作为判断frmYuDing 窗体是从frmQZClient窗体中单击下定金预定调用的'还是直接菜单调用的Public fromqzc As Boolean'定义全局变量fromYuding 作为判断frmPayDingJin 窗体是从frmYuDing窗体中单击收取定金调用的'还是直接菜单调用的Public fromYuding As Boolean'定义全局变量fromContract 作为判断frmPayYaJin 窗体是从frmSignContract窗体中单击收取押金调用的'还是直接菜单调用的Public fromContract As Boolean'定义全局变量ZuJinfromContract 作为判断frmPayZuJin 窗体是从frmSignContract窗体中单击收取租金调用的'还是直接菜单调用的Public ZuJinfromContract As Boolean'定义全局变量queryZuJin 作为判断frmAdminZuJin 窗体显示查询的数据还是全体数据Public queryZuJin As Boolean'定义全局变量sqlqzj 作为查询合同信息时的sql语句Public sqlqzj As String'定义全局变量sqlqdj 作为查询定金信息时的sql语句Public sqlqdj As String'定义全局变量sqlqyj 作为查询押金信息时的sql语句Public sqlqyj As String1.各主要功能模块的设计与实现11基本资料管理模块设计房屋基本资料管理的运行效果图如下:其表单界面的属性设计比较直观,在此重点分析新增,修改,删除,保存四个命令按钮的源代码设计：新增按钮源码:Private Sub cmdAdd_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框，并且设置它们可写 For i = 0 To 7 Text1(i).Text = "" Text1(i).Enabled = True Next i Combo1.Enabled = True 'add变量用于保存时判断是从添加还是修改后保存 add = 1 Text1(0).SetFocus End SubPrivate Sub cmdCancel_Click() '取消按钮用于用户添加或修改过程中放弃添加或修改操作 cmdSave.Enabled = False cmdCancel.Enabled = False cmdAdd.Enabled = True cmdQuery.Enabled = True '如果是从添加后取消 If add = 1 Then '如果当前House表中有数据则显示第一条数据 If Not rs_house.EOF And Not rs_house.BOF Then For i = 0 To 7 Text1(i).Text = rs_house.Fields(i) Next i If rs_house.Fields(8) = "已租" Then Combo1.ListIndex = 0 ElseIf rs_house.Fields(8) = "未租" Then Combo1.ListIndex = 1 ElseIf rs_house.Fields(8) = "意向" Then Combo1.ListIndex = 2 End If cmdEdit.Enabled = True cmdDel.Enabled = True cmdFirst.Enabled = True cmdPrev.Enabled = True cmdNext.Enabled = True cmdLast.Enabled = True '如果没有数据，则显示空 Else For i = 0 To 7 Text1(i).Text = "" Next i cmdEdit.Enabled = False cmdDel.Enabled = False cmdFirst.Enabled = False cmdPrev.Enabled = False cmdNext.Enabled = False cmdLast.Enabled = False End If '如果是修改后取消，则恢复到修改前的数据 ElseIf add = 0 Then For i = 0 To 7 Text1(i).Text = rs_house.Fields(i) Next i If rs_house.Fields(8) = "已租" Then Combo1.ListIndex = 0 ElseIf rs_house.Fields(8) = "未租" Then Combo1.ListIndex = 1 ElseIf rs_house.Fields(8) = "意向" Then Combo1.ListIndex = 2 End If End If '开始时设置各个text框不可写 For i = 0 To 7 Text1(i).Enabled = False Next i '先设置ComboBox的默认值及不可改 Combo1.Enabled = FalseEnd SubPrivate Sub cmdClose_Click() Unload MeEnd Sub删除按钮的源代码：Private Sub cmdDel_Click() '当单击删除记录时，需要弹出一个提示框，警告用户 Dim answer As String answer = MsgBox("确定要删除吗？", vbYesNo, "") '确实删除 If answer = vbYes Then rs_house.Delete '删除当前记录 rs_house.Update '更新删除 MsgBox "成功删除！", vbOKOnly + vbExclamation, "" Else Exit Sub End If '删除之后，显示总信息条数需要减 1 Text2.Text = Val(Text2.Text) - 1 '删除当前记录后，需要显示下一条记录，如果删除的是最后一条记录，则显示上一条记录 '先移动rs_house记录到后一条 rs_house.MoveNext If rs_house.EOF Then rs_house.MovePrevious '如果没有到记录首则显示该记录 If Not rs_house.BOF Then For i = 0 To 7 Text1(i).Text = rs_house.Fields(i) Next i If rs_house.Fields(8) = "已租" Then Combo1.ListIndex = 0 ElseIf rs_house.Fields(8) = "未租" Then Combo1.ListIndex = 1 ElseIf rs_house.Fields(8) = "意向" Then Combo1.ListIndex = 2 End If '如果到记录首，则表格已经为空，置所有text框显示为空 ElseIf rs_house.BOF Then For i = 0 To 7 Text1(i).Text = "" Next i cmdFirst.Enabled = False cmdPrev.Enabled = False cmdNext.Enabled = False cmdLast.Enabled = False End If '如果删除的不是首尾记录，则显示当前记录即可 Else For i = 0 To 7 Text1(i).Text = rs_house.Fields(i) Next i If rs_house.Fields(8) = "已租" Then Combo1.ListIndex = 0 ElseIf rs_house.Fields(8) = "未租" Then Combo1.ListIndex = 1 ElseIf rs_house.Fields(8) = "意向" Then Combo1.ListIndex = 2 End If End IfEnd 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框可写 For i = 1 To 7 Text1(i).Enabled = True Next i Combo1.Enabled = True add = 0End SubPrivate Sub cmdFirst_Click() '先移动rs_house记录到第一条 rs_house.MoveFirst '同时需要设置相应按钮为不可用和不可用 cmdPrev.Enabled = False cmdFirst.Enabled = False cmdNext.Enabled = True cmdLast.Enabled = True '如果已经是第一条记录，则提示用户 If rs_house.BOF = True Then MsgBox "对不起，已经是第一条记录了！", vbOKOnly + vbInformation, "注意" Exit Sub '如果不是，则个数据表的记录位置移到第一条记录，并且显示之 Else For i = 0 To 7 Text1(i).Text = rs_house.Fields(i) Next i If rs_house.Fields(8) = "已租" Then Combo1.ListIndex = 0 ElseIf rs_house.Fields(8) = "未租" Then Combo1.ListIndex = 1 ElseIf rs_house.Fields(8) = "意向" Then Combo1.ListIndex = 2 End If End IfEnd SubPREV检索按钮的源代码：12 客户资料管理模块的设计121租户基本资料的设计运行效果图如下所示:在租户基本资料中，我们重点分析查找家庭租户功能的源码，如下:Private Sub cmdQuery_Click() If Text1.Text = "" Then MsgBox "查询条件不可为空！", vbOKOnly + vbInformation, "注意" Text1.SetFocus Exit Sub End If '设置查询家庭租户变量为真 querycf = True sqlqcf = " where " & Combo1.Text & " = " & "'" & Text1.Text & "'" frmClient.Show '关闭本窗体 Unload MeEnd Sub122求租户基本资料的设计其保存按钮的源码分析如下：Private Sub cmdSave_Click() '检测数据是否完整 If Text1(0).Text = "" Then MsgBox "求租客户编号不可为空！", vbOKOnly + vbInformation, "注意" Text1(0).SetFocus Exit Sub ElseIf Text1(1).Text = "" Then MsgBox "求租客户姓名不可为空！", vbOKOnly + vbInformation, "注意" Text1(1).SetFocus Exit Sub ElseIf Text1(2).Text = "" Then MsgBox "求租客户电话不可为空！", vbOKOnly + vbInformation, "注意" Text1(2).SetFocus Exit Sub ElseIf Not Text1(4).Text = "" And IsNumeric(Text1(4).Text) = False Then MsgBox "面积要求不为空则应为数字！", vbOKOnly + vbInformation, "注意" Text1(4).SetFocus Exit Sub ElseIf Not Text1(6).Text = "" And IsNumeric(Text1(6).Text) = False Then MsgBox "意向价位不为空则应为数字！", vbOKOnly + vbInformation, "注意" Text1(6).SetFocus Exit Sub ElseIf Not Text1(7).Text = "" And IsNumeric(Text1(7).Text) = False Then MsgBox "意向租期不为空则应为数字！", vbOKOnly + vbInformation, "注意" Text1(7).SetFocus Exit Sub End If '如果意向房屋编号不为空，需要检查是否存在 If Not Text1(8).Text = "" Then Dim sqlhcheck As String Dim rs_hcheck As New ADODB.Recordset sqlhcheck = "select * from House where 房屋编号 = '" & Text1(8).Text & "'" rs_hcheck.Open sqlhcheck, conn, adOpenStatic, adLockOptimistic If rs_hcheck.EOF ThenMsgBox "该房屋编号不存在，请重填或清空！", vbOKOnly + vbInformation, "注意" Text1(8).SetFocus rs_hcheck.Close Exit Sub End If rs_hcheck.Close End If '添加数据后保存 If add = 1 Then '检测房屋编号这个主键是否已经在表中存在 Dim rs_check As New ADODB.Recordset Dim sqlCheck As String sqlCheck = "select * from QZClient where 求租客户编号= '" & (Text1(0).Text) & "'" rs_check.Open sqlCheck, conn, adOpenStatic, adLockOptimistic If Not rs_check.EOF And Not rs_check.BOF Then MsgBox "该求租客户编号已经存在，请重填一个！", vbOKOnly + vbInformation, "注意" rs_check.Close Text1(0).SetFocus Text1(0).Text = "" Exit Sub End If rs_check.Close '主键不重复，可以加入表中 rs_QZClient.AddNew For i = 0 To 9 rs_QZClient.Fields(i) = Text1(i).Text Next i rs_QZClient.Update '添加之后显示总共条数信息加 1 Text2.Text = Val(Text2.Text) + 1 '修改数据后的保存 Else rs_QZClient.Update End If MsgBox "保存数据成功！", vbOKOnly + vbInformation, "祝贺" '保存后需要设置其他按钮可用，以及各个text框不可写 cmdAdd.Enabled = True cmdEdit.Enabled = True cmdDel.Enabled = True cmdSave.Enabled = False cmdCancel.Enabled = False cmdFirst.Enabled = True cmdPrev.Enabled = True cmdNext.Enabled = True cmdLast.Enabled = True cmdQuery.Enabled = True cmdYuDing.Enabled = True For i = 0 To 9 Text1(i).Enabled = False Next i End Sub13 租赁管理模块的设计13 .1签订合同的设计因租赁管理，财务管理和统计报表三个模块的窗体设计比较多，无法一一描述，故选择有代表性的窗体设计加以分析，其合同签订窗体的运行效果图如下:如图所示,签订的源码设计如下:Private Sub cmdSign_Click() '先检查输入数据完整性 For i = 0 To 2 If Text1(i).Text = "" Then MsgBox "除备注外的所有项不可为空！", vbOKOnly + vbInformation, "注意" Text1(i).SetFocus Exit Sub End If Next i For i = 3 To 4 If Text1(i).Text = "" Or IsDate(Text1(i).Text) = False ThenMsgBox "日期应为这样的格式：2003-7-15！", vbOKOnly + vbInformation, "注意" Text1(i).SetFocus Exit Sub End If Next i If Text1(6).Text = "" Or IsNumeric(Text1(6).Text) = False Then MsgBox "月租金应为数字！", vbOKOnly + vbInformation, "注意" Text1(6).SetFocus Exit Sub End If If Text1(8).Text = "" Or IsNumeric(Text1(8).Text) = False Then MsgBox "押金应为数字！", vbOKOnly + vbInformation, "注意" Text1(8).SetFocus Exit Sub End If If Text1(9).Text = "" Then MsgBox "业务员不可为空！", vbOKOnly + vbInformation, "注意" Text1(9).SetFocus Exit Sub End If If Text1(10).Text = "" Or IsDate(Text1(10).Text) = False ThenMsgBox "签订日期应为这样的格式：2003-7-15！", vbOKOnly + vbInformation, "注意" Text1(10).SetFocus Exit Sub End If '止租日期不能前于起租日期 If DateValue(Text1(4).Text) < DateValue(Text1(3).Text) Then MsgBox "止租日期不能前于起租日期", vbOKOnly + vbInformation, "注意" Text1(4).SetFocus Exit Sub End If '租期等于起租日期和止租日期之差，结尾不足一月，按一月计。 '使用datediff 函数计算日期之差 Text1(5).Text = Int(DateDiff("d", DateValue(Text1(3).Text), DateValue(Text1(4).Text) / 31) + 1 '总租金等于月租金乘以租期 Text1(7).Text = Val(Text1(5).Text) * Val(Text1(6).Text) '检查完数据完整性后，还需要检查该客户是否已存入租户表中，以及该房屋是否为未出租或预定状态 sqlc = "select * from Client where 租户姓名 = '" & Text1(1).Text & "'" rs_ccheck.Open sqlc, conn, adOpenStatic, adLockOptimistic If rs_ccheck.EOF = True Then rs_ccheck.Close MsgBox "该客户资料还未存入租户资料表中，请先录入该客户资料！", vbOKOnly + vbInformation, "注意" Exit Sub End If rs_ccheck.Close '检测房屋状态 sqlh = "select * from House where 房屋编号 = '" & Text1(2).Text & "'" rs_hcheck.Open sqlh, conn, adOpenStatic, adLockOptimistic If rs_hcheck.EOF = True ThenMsgBox "该房屋编号不存在，请重新输入一个！", vbOKOnly + vbInformation, "注意" Text1(2).SetFocus rs_hcheck.Close Exit Sub ElseIf rs_hcheck.Fields(8) = "已租" ThenMsgBox "该房屋已经出租了，请选择另一房屋！", vbOKOnly + vbInformation, "注意" rs_hcheck.Close Exit Sub'如果该房屋状态为预定，则需要看预定人是否为该客户，如果不是，需要弹出对话框提示用户 ElseIf rs_hcheck.Fields(8) = "预定" Then '检查该客户是否为预定客户sqlyd = "select * from YuDing where 预定房屋编号 = '" & Text1(2).Text & " '" rs_yd.Open sqlyd, conn, adOpenStatic, adLockOptimistic '如果该客户不是预定客户，检查预定有效期 If Not rs_yd.Fields(1) = Text1(1).Text Then '如果已经过了预定有效期，别的用户可以承租 If (Date > DateAdd(d, rs_yd.Fields(4), rs_yd.Fields(8) Then '出租，加入合同表 sqlcon = "select * from Contract" rs_contract.Open sqlcon, conn, adOpenStatic, adLockOptimistic rs_contract.AddNew For i = 0 To 11 rs_contract.Fields(i) = Text1(i).Text Next i rs_contract.Update '修改房屋状态 rs_hcheck(8) = "已租" rs_hcheck.Update '检查求租客户表中是否有该客户，如果有，则删除之sqlqzc = "select * from QZClient where 求租客户姓名 = '" & Text1(1).Text & "'" rs_qzc.Open sqlqzc, conn, adOpenStatic, adLockOptimistic If rs_qzc.EOF = False Then rs_qzc.Delete rs_qzc.Update End If '显示签订合同成功 MsgBox "签订合同成功！", vbOKOnly + vbInformation, "注意" '设置签订按钮不可用 cmdSign.Enabled = False cmdYaJin.Enabled = True cmdZuJin.Enabled = True '关闭所有打开的记录集 rs_qzc.Close rs_yd.Close rs_hcheck.Close rs_contract.Close Exit Sub ElseMsgBox "该房屋已经被别人预定了，请选择另一房屋！", vbOKOnly + vbInformation, "注意" rs_hcheck.Close rs_yd.Close Exit Sub End If '该客户即为预定客户，可以出租 ElseIf rs_yd.Fields(1) = Text1(1).Text Then '出租，加入合同表 sqlcon = "select * from Contract" rs_contract.Open sqlcon, conn, adOpenStatic, adLockOptimistic rs_contract.AddNew For i = 0 To 11 rs_contract.Fields(i) = Text1(i).Text Next i rs_contract.Update '修改房屋状态 rs_hcheck(8) = "已租" rs_hcheck.Update '删除预定表中该项 rs_yd.Delete rs_yd.Update '检查求租客户表中是否有该客户，如果有，则删除之sqlqzc = "select * from QZClient where 求租客户姓名 = '" & Text1(1).Text & "'" rs_qzc.Open sqlqzc, conn, adOpenStatic, adLockOptimistic If rs_qzc.EOF =