房屋租赁管理系统源代码

系统主界面的设计启动系统后，主界面设计效果图如下:公用模块的设计代码分析如下:OptionExplicitPublicconnAsNewADODB.Connection'定义全局变量queryhouse作为判断frmHouse窗体显示查询的数据还是全体数据PublicqueryhouseAsBoolean'定义全局变量sqlqh作为查询房屋信息时的sql语句PublicsqlqhAsString'定义全局变量querycf作为判断frmClient窗体家庭租户选项卡显示查询的数据还是全体数据PublicquerycfAsBoolean'定义全局变量sqlqcf作为查询家庭租户信息时的sql语句PublicsqlqcfAsString'定义全局变量querycg作为判断frmClient窗体家公司户选项卡显示查询的数据还是全体数据PublicquerycgAsBoolean'定义全局变量sqlqcg作为查询公司租户信息时的sql语句PublicsqlqcgAsString'定义全局变量queryemp作为判断frmEmp窗体显示查询的数据还是全体数据PublicqueryempAsBoolean'定义全局变量sqlqe作为查询员工信息时的sql语句PublicsqlqeAsString'定义全局变量queryqzc作为判断frmQZClient窗体显示查询的数据还是全体数据PublicqueryqzcAsBoolean'定义全局变量sqlqzc作为查询求租客户信息时的sql语句PublicsqlqzcAsString'定义全局变量querycon作为判断frmAdminContract窗体显示查询的数据还是全体数据PublicqueryconAsBoolean'定义全局变量sqlqcon作为查询协议信息时的sql语句PublicsqlqconAsString'定义全局变量sqlqyd作为查询预定单信息时的sql语句PublicsqlqydAsString'定义全局变量fromqzc作为判断frmYuDing窗体是从frmQZClient窗体中单击下定金预定调用的'还是直接菜单调用的PublicfromqzcAsBoolean'定义全局变量fromYuding作为判断frmPayDingJin窗体是从frmYuDing窗体中单击收取定金调用的'还是直接菜单调用的PublicfromYudingAsBoolean'定义全局变量fromContract作为判断frmPayYaJin窗体是从frmSignContract窗体中单击收取押金调用的'还是直接菜单调用的PublicfromContractAsBoolean'定义全局变量ZuJinfromContract作为判断frmPayZuJin窗体是从frmSignContract窗体中单击收取租金调用的'还是直接菜单调用的PublicZuJinfromContractAsBoolean'定义全局变量queryZuJin作为判断frmAdminZuJin窗体显示查询的数据还是全体数据PublicqueryZuJinAsBoolean'定义全局变量sqlqzj作为查询协议信息时的sql语句PublicsqlqzjAsString'定义全局变量sqlqdj作为查询定金信息时的sql语句PublicsqlqdjAsString'定义全局变量sqlqyj作为查询押金信息时的sql语句PublicsqlqyjAsString1.各重要功能模块的设计与实现1．1基本资料管理模块设计房屋基本资料管理的运营效果图如下:其表单界面的属性设计比较直观,在此重点分析新增,修改,删除,保存四个命令按钮的源代码设计：新增按钮源码:PrivateSubcmdAdd_Click()'设立除保存和取消按钮外的其他按钮不可用cmdAdd.Enabled=FalsecmdEdit.Enabled=FalsecmdDel.Enabled=FalsecmdSave.Enabled=TruecmdCancel.Enabled=TruecmdFirst.Enabled=FalsecmdPrev.Enabled=FalsecmdNext.Enabled=FalsecmdLast.Enabled=FalsecmdQuery.Enabled=False'需要清空所有text框，并且设立它们可写Fori=0To7Text1(i).Text=""Text1(i).Enabled=TrueNextiCombo1.Enabled=True'add变量用于保存时判断是从添加还是修改后保存add=1Text1(0).SetFocusEndSubPrivateSubcmdCancel_Click()'取消按钮用于用户添加或修改过程中放弃添加或修改操作cmdSave.Enabled=FalsecmdCancel.Enabled=FalsecmdAdd.Enabled=TruecmdQuery.Enabled=True'假如是从添加后取消Ifadd=1Then'假如当前House表中有数据则显示第一条数据IfNotrs_house.EOFAndNotrs_house.BOFThenFori=0To7Text1(i).Text=rs_house.Fields(i)NextiIfrs_house.Fields(8)="已租"ThenCombo1.ListIndex=0ElseIfrs_house.Fields(8)="未租"ThenCombo1.ListIndex=1ElseIfrs_house.Fields(8)="意向"ThenCombo1.ListIndex=2EndIfcmdEdit.Enabled=TruecmdDel.Enabled=TruecmdFirst.Enabled=TruecmdPrev.Enabled=TruecmdNext.Enabled=TruecmdLast.Enabled=True'假如没有数据，则显示空ElseFori=0To7Text1(i).Text=""NexticmdEdit.Enabled=FalsecmdDel.Enabled=FalsecmdFirst.Enabled=FalsecmdPrev.Enabled=FalsecmdNext.Enabled=FalsecmdLast.Enabled=FalseEndIf'假如是修改后取消，则恢复到修改前的数据ElseIfadd=0ThenFori=0To7Text1(i).Text=rs_house.Fields(i)NextiIfrs_house.Fields(8)="已租"ThenCombo1.ListIndex=0ElseIfrs_house.Fields(8)="未租"ThenCombo1.ListIndex=1ElseIfrs_house.Fields(8)="意向"ThenCombo1.ListIndex=2EndIfEndIf'开始时设立各个text框不可写Fori=0To7Text1(i).Enabled=FalseNexti'先设立ComboBox的默认值及不可改Combo1.Enabled=FalseEndSubPrivateSubcmdClose_Click()UnloadMeEndSub删除按钮的源代码：PrivateSubcmdDel_Click()'当单击删除记录时，需要弹出一个提醒框，警告用户DimanswerAsStringanswer=MsgBox("拟定要删除吗？",vbYesNo,"")'的确删除Ifanswer=vbYesThenrs_house.Delete'删除当前记录rs_house.Update'更新删除MsgBox"成功删除！",vbOKOnly+vbExclamation,""ElseExitSubEndIf'删除之后，显示总信息条数需要减1Text2.Text=Val(Text2.Text)-1'删除当前记录后，需要显示下一条记录，假如删除的是最后一条记录，则显示上一条记录'先移动rs_house记录到后一条rs_house.MoveNextIfrs_house.EOFThenrs_house.MovePrevious'假如没有到记录首则显示该记录IfNotrs_house.BOFThenFori=0To7Text1(i).Text=rs_house.Fields(i)NextiIfrs_house.Fields(8)="已租"ThenCombo1.ListIndex=0ElseIfrs_house.Fields(8)="未租"ThenCombo1.ListIndex=1ElseIfrs_house.Fields(8)="意向"ThenCombo1.ListIndex=2EndIf'假如到记录首，则表格已经为空，置所有text框显示为空ElseIfrs_house.BOFThenFori=0To7Text1(i).Text=""NexticmdFirst.Enabled=FalsecmdPrev.Enabled=FalsecmdNext.Enabled=FalsecmdLast.Enabled=FalseEndIf'假如删除的不是首尾记录，则显示当前记录即可ElseFori=0To7Text1(i).Text=rs_house.Fields(i)NextiIfrs_house.Fields(8)="已租"ThenCombo1.ListIndex=0ElseIfrs_house.Fields(8)="未租"ThenCombo1.ListIndex=1ElseIfrs_house.Fields(8)="意向"ThenCombo1.ListIndex=2EndIfEndIfEndSub保存按钮的源代码：PrivateSubcmdEdit_Click()'设立除保存和取消按钮外的其他按钮不可用cmdAdd.Enabled=FalsecmdEdit.Enabled=FalsecmdDel.Enabled=FalsecmdSave.Enabled=TruecmdCancel.Enabled=TruecmdFirst.Enabled=FalsecmdPrev.Enabled=FalsecmdNext.Enabled=FalsecmdLast.Enabled=FalsecmdQuery.Enabled=False'需要设立除主键之外的text框可写Fori=1To7Text1(i).Enabled=TrueNextiCombo1.Enabled=Trueadd=0EndSubPrivateSubcmdFirst_Click()'先移动rs_house记录到第一条rs_house.MoveFirst'同时需要设立相应按钮为不可用和不可用cmdPrev.Enabled=FalsecmdFirst.Enabled=FalsecmdNext.Enabled=TruecmdLast.Enabled=True'假如已经是第一条记录，则提醒用户Ifrs_house.BOF=TrueThenMsgBox"对不起，已经是第一条记录了！",vbOKOnly+vbInformation,"注意"ExitSub'假如不是，则个数据表的记录位置移到第一条记录，并且显示之ElseFori=0To7Text1(i).Text=rs_house.Fields(i)NextiIfrs_house.Fields(8)="已租"ThenCombo1.ListIndex=0ElseIfrs_house.Fields(8)="未租"ThenCombo1.ListIndex=1ElseIfrs_house.Fields(8)="意向"ThenCombo1.ListIndex=2EndIfEndIfEndSubPREV检索按钮的源代码：1．2客户资料管理模块的设计1．2．1租户基本资料的设计运营效果图如下所示:在租户基本资料中，我们重点分析查找家庭租户功能的源码，如下:PrivateSubcmdQuery_Click()IfText1.Text=""ThenMsgBox"查询条件不可为空！",vbOKOnly+vbInformation,"注意"Text1.SetFocusExitSubEndIf'设立查询家庭租户变量为真querycf=Truesqlqcf="where"&Combo1.Text&"="&"'"&Text1.Text&"'"frmClient.Show'关闭本窗体UnloadMeEndSub1．2．2求租户基本资料的设计其保存按钮的源码分析如下：PrivateSubcmdSave_Click()'检测数据是否完整IfText1(0).Text=""ThenMsgBox"求租客户编号不可为空！",vbOKOnly+vbInformation,"注意"Text1(0).SetFocusExitSubElseIfText1(1).Text=""ThenMsgBox"求租客户姓名不可为空！",vbOKOnly+vbInformation,"注意"Text1(1).SetFocusExitSubElseIfText1(2).Text=""ThenMsgBox"求租客户电话不可为空！",vbOKOnly+vbInformation,"注意"Text1(2).SetFocusExitSubElseIfNotText1(4).Text=""AndIsNumeric(Text1(4).Text)=FalseThenMsgBox"面积规定不为空则应为数字！",vbOKOnly+vbInformation,"注意"Text1(4).SetFocusExitSubElseIfNotText1(6).Text=""AndIsNumeric(Text1(6).Text)=FalseThenMsgBox"意向价位不为空则应为数字！",vbOKOnly+vbInformation,"注意"Text1(6).SetFocusExitSubElseIfNotText1(7).Text=""AndIsNumeric(Text1(7).Text)=FalseThenMsgBox"意向租期不为空则应为数字！",vbOKOnly+vbInformation,"注意"Text1(7).SetFocusExitSubEndIf'假如意向房屋编号不为空，需要检查是否存在IfNotText1(8).Text=""ThenDimsqlhcheckAsStringDimrs_hcheckAsNewADODB.Recordsetsqlhcheck="select*fromHousewhere房屋编号='"&Text1(8).Text&"'"rs_hcheck.Opensqlhcheck,conn,adOpenStatic,adLockOptimisticIfrs_hcheck.EOFThenMsgBox"该房屋编号不存在，请重填或清空！",vbOKOnly+vbInformation,"注意"Text1(8).SetFocusrs_hcheck.CloseExitSubEndIfrs_hcheck.CloseEndIf'添加数据后保存Ifadd=1Then'检测房屋编号这个主键是否已经在表中存在Dimrs_checkAsNewADODB.RecordsetDimsqlCheckAsStringsqlCheck="select*fromQZClientwhere求租客户编号='"&(Text1(0).Text)&"'"rs_check.OpensqlCheck,conn,adOpenStatic,adLockOptimisticIfNotrs_check.EOFAndNotrs_check.BOFThenMsgBox"该求租客户编号已经存在，请重填一个！",vbOKOnly+vbInformation,"注意"rs_check.CloseText1(0).SetFocusText1(0).Text=""ExitSubEndIfrs_check.Close'主键不反复，可以加入表中rs_QZClient.AddNewFori=0To9rs_QZClient.Fields(i)=Text1(i).TextNextirs_QZClient.Update'添加之后显示总共条数信息加1Text2.Text=Val(Text2.Text)+1'修改数据后的保存Elsers_QZClient.UpdateEndIfMsgBox"保存数据成功！",vbOKOnly+vbInformation,"祝贺"'保存后需要设立其他按钮可用，以及各个text框不可写cmdAdd.Enabled=TruecmdEdit.Enabled=TruecmdDel.Enabled=TruecmdSave.Enabled=FalsecmdCancel.Enabled=FalsecmdFirst.Enabled=TruecmdPrev.Enabled=TruecmdNext.Enabled=TruecmdLast.Enabled=TruecmdQuery.Enabled=TruecmdYuDing.Enabled=TrueFori=0To9Text1(i).Enabled=FalseNextiEndSub1．3租赁管理模块的设计1．3.1签订协议的设计因租赁管理，财务管理和记录报表三个模块的窗体设计比较多，无法一一描述，故选择有代表性的窗体设计加以分析，其协议签订窗体的运营效果图如下:如图所示,签订的源码设计如下:PrivateSubcmdSign_Click()'先检查输入数据完整性Fori=0To2IfText1(i).Text=""ThenMsgBox"除备注外的所有项不可为空！",vbOKOnly+vbInformation,"注意"Text1(i).SetFocusExitSubEndIfNextiFori=3To4IfText1(i).Text=""OrIsDate(Text1(i).Text)=FalseThenMsgBox"日期应为这样的格式：2023-7-15！",vbOKOnly+vbInformation,"注意"Text1(i).SetFocusExitSubEndIfNextiIfText1(6).Text=""OrIsNumeric(Text1(6).Text)=FalseThenMsgBox"月租金应为数字！",vbOKOnly+vbInformation,"注意"Text1(6).SetFocusExitSubEndIfIfText1(8).Text=""OrIsNumeric(Text1(8).Text)=FalseThenMsgBox"押金应为数字！",vbOKOnly+vbInformation,"注意"Text1(8).SetFocusExitSubEndIfIfText1(9).Text=""ThenMsgBox"业务员不可为空！",vbOKOnly+vbInformation,"注意"Text1(9).SetFocusExitSubEndIfIfText1(10).Text=""OrIsDate(Text1(10).Text)=FalseThenMsgBox"签订日期应为这样的格式：2023-7-15！",vbOKOnly+vbInformation,"注意"Text1(10).SetFocusExitSubEndIf'止租日期不能前于起租日期IfDateValue(Text1(4).Text)<DateValue(Text1(3).Text)ThenMsgBox"止租日期不能前于起租日期",vbOKOnly+vbInformation,"注意"Text1(4).SetFocusExitSubEndIf'租期等于起租日期和止租日期之差，结尾局限性一月，按一月计。'使用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*fromClientwhere租户姓名='"&Text1(1).Text&"'"rs_ccheck.Opensqlc,conn,adOpenStatic,adLockOptimisticIfrs_ccheck.EOF=TrueThenrs_ccheck.CloseMsgBox"该客户资料尚未存入租户资料表中，请先录入该客户资料！",vbOKOnly+vbInformation,"注意"ExitSubEndIfrs_ccheck.Close'检测房屋状态sqlh="select*fromHousewhere房屋编号='"&Text1(2).Text&"'"rs_hcheck.Opensqlh,conn,adOpenStatic,adLockOptimisticIfrs_hcheck.EOF=TrueThenMsgBox"该房屋编号不存在，请重新输入一个！",vbOKOnly+vbInformation,"注意"Text1(2).SetFocusrs_hcheck.CloseExitSubElseIfrs_hcheck.Fields(8)="已租"ThenMsgBox"该房屋已经出租了，请选择另一房屋！",vbOKOnly+vbInformation,"注意"rs_hcheck.CloseExitSub'假如该房屋状态为预定，则需要看预定人是否为该客户，假如不是，需要弹出对话框提醒用户ElseIfrs_hcheck.Fields(8)="预定"Then'检查该客户是否为预定客户sqlyd="select*fromYuDingwhere预定房屋编号='"&Text1(2).Text&"'"rs_yd.Opensqlyd,conn,adOpenStatic,adLockOptimistic'假如该客户不是预定客户，检查预定有效期IfNotrs_yd.Fields(1)=Text1(1).TextThen'假如已通过了预定有效期，别的用户可以承租If(Date>DateAdd(d,rs_yd.Fields(4),rs_yd.Fields(8)))Then'出租，加入协议表sqlcon="select*fromContract"rs_contract.Opensqlcon,conn,adOpenStatic,adLockOptimisticrs_contract.AddNewFori=0To11rs_contract.Fields(i)=Text1(i).TextNextirs_contract.Update'修改房屋状态rs_hcheck(8)="已租"rs_hcheck.Update'检查求租客户表中是否有该客户，假如有，则删除之sqlqzc="select*fromQZClientwhere求租客户姓名='"&Text1(1).Text&"'"rs_qzc.Opensqlqzc,conn,adOpenStatic,adLockOptimisticIfrs_qzc.EOF=FalseThenrs_qzc.Deleters_qzc.UpdateEndIf'显示签订协议成功MsgBox"签订协议成功！",vbOKOnly+vbInformation,"注意"'设立签订按钮不可用cmdSign.Enabled=FalsecmdYaJin.Enabled=TruecmdZuJin.Enabled=True'关闭所有打开的记录集rs_qzc.Closers_yd.Closers_hcheck.Closers_contract.CloseExitSubElseMsgBox"该房屋已经被别人预定了，请选择另一房屋！",vbOKOnly+vbInformation,"注意"rs_hcheck.Closers_yd.CloseExitSubEndIf'该客户即为预定客户，可以出租ElseIfrs_yd.Fields(1)=Text1(1).TextThen'出租，加入协议表sqlcon="select*fromContract"rs_contract.Opensqlcon,conn,adOpenStatic,adLockOptimisticrs_contract.AddNewFori=0To11rs_contract.Fields(i)=Text1(i).TextNextirs_contract.Update'修改房屋状态rs_hcheck(8)="已租"rs_hcheck.Update'删除预定表中该项rs_yd.Deleters_yd.Update'检查求租客户表中是否有该客户，假如有，则删除之sqlqzc="select*fromQZClientwhere求租客户姓名='"&Text1(1).Text&"'"rs_qzc.Opensqlqzc,conn,adOpenStatic,adLockOptimisticIfrs_qzc.EOF=FalseThenrs_qzc.Deleters_qzc.UpdateEndIf'显示签订协议成功MsgBox"签订协议成功！！",vbOKOnly+vbInformation,"注意"'设立签订按钮不可用cmdSign.Enabled=FalsecmdYaJin.Enabled=TruecmdZuJin.Enabled=True'关闭所有打开的记录集rs_qzc.Closers_yd.Closers_hcheck.Closers_contract.CloseExitSubEndIf'假如该房屋状态为未租，则可以顺利出租ElseIfrs_hcheck.Fields(8)="未租"Then'出租，加入协议表sqlcon="select*fromContract"rs_contract.Opensqlcon,conn,adOpenStatic,adLockOptimisticrs_contract.AddNewFori=0To11rs_contract.Fields(i)=Text1(i).TextNextirs_contract.Update'修改房屋状态rs_hcheck(8)="已租"rs_hcheck.Update'检查求租客户表中是否有该客户，假如有，则删除之sqlqzc="select*fromQZClientwhere求租客户姓名='"&Text1(1).Text&"'"rs_qzc.Opensqlqzc,conn,adOpenStatic,adLockOptimisticIfrs_qzc.EOF=FalseThenrs_qzc.Deleters_qzc.UpdateEndIf'显示签订协议成功MsgBox"签订协议成功！",vbOKOnly+vbInformation,"注意"'设立签订按钮不可用cmdSign.Enabled=FalsecmdYaJin.Enabled=TruecmdZuJin.Enabled=True'关闭所有打开的记录集rs_qzc.Closers_hcheck.Closers_contract.CloseExitSubEndIf1．3.2预定租房的设计其收取定金的设计如下：PrivateSubcmdDingJin_Click()fromYuding=TruecmdDingJin.Enabled=FalsefrmPayDingJin.ShowEndSub1．4财务管理模块的设计1．4.1定金收取的设计系统维护的运营效果图如下:其收取定金按钮的源码设计如下:PrivateSubcmdAdd_Click()'先检测数据完整性IfText1(0).Text=""ThenMsgBox"收费编号不可为空！",vbOKOnly+vbInformation,"注意"Text1(0).SetFocusExitSubEndIfIfText1(2).Text=""OrIsDate(Text1(2).Text)=FalseThenMsgBox"收费日期应为这样的日期格式：2023-8-3！",vbOKOnly+vbInformation,"注意"Text1(2).SetFocusExitSubEndIfIfText1(3).Text=""ThenMsgBox"预定单编号不可为空！",vbOKOnly+vbInformation,"注意"Text1(3).SetFocusExitSubEndIf