房屋租赁管理系统源代码.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) 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 =