搜索
热门搜索 :
考研考公
首页 热点资讯 义务教育 高等教育 出国留学 考研考公
您的当前位置：首页正文

(房地产经营管理)房屋租赁管理系统源代码

来源：伴沃教育
系统主界面的设计

启动系统后，主界面设计效果图如下: 公用模块的设计代码分析如下: OptionExplicit

PublicconnAsNewADODB.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语句 PublicsqlqyjAsString

1.各主要功能模块的设计与实现 1．1基本资料管理模块设计

房屋基本资料管理的运行效果图如下:

其表单界面的属性设计比较直观,在此重点分析新增,修改,删除,保存四个命令按钮的源代码设计： 新增按钮源码:

PrivateSubcmdAdd_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框，并且设置它们可写 Fori=0To7 Text1(i).Text=\"\" Text1(i).Enabled=True Nexti

bo1.Enabled=True

'add变量用于保存时判断是从添加还是修改后保存 add=1

Text1(0).SetFocus EndSub

PrivateSubcmdCancel_Click()

'取消按钮用于用户添加或修改过程中放弃添加或修改操作 cmdSave.Enabled=False cmdCancel.Enabled=False cmdAdd.Enabled=True cmdQuery.Enabled=True '如果是从添加后取消 Ifadd=1Then

'如果当前House表中有数据则显示第一条数据 IfNotrs_house.EOFAndNotrs_house.BOFThen Fori=0To7

Text1(i).Text=rs_house.Fields(i) Nexti

Ifrs_house.Fields(8)=\"已租\"Then bo1.ListIndex=0

ElseIfrs_house.Fields(8)=\"未租\"Then bo1.ListIndex=1

ElseIfrs_house.Fields(8)=\"意向\"Then bo1.ListIndex=2 EndIf

cmdEdit.Enabled=True cmdDel.Enabled=True cmdFirst.Enabled=True

cmdPrev.Enabled=True cmdNext.Enabled=True cmdLast.Enabled=True '如果没有数据，则显示空 Else Fori=0To7 Text1(i).Text=\"\" Nexti

cmdEdit.Enabled=False cmdDel.Enabled=False cmdFirst.Enabled=False cmdPrev.Enabled=False cmdNext.Enabled=False cmdLast.Enabled=False EndIf

'如果是修改后取消，则恢复到修改前的数据 ElseIfadd=0Then Fori=0To7

Text1(i).Text=rs_house.Fields(i) Nexti

Ifrs_house.Fields(8)=\"已租\"Then bo1.ListIndex=0

ElseIfrs_house.Fields(8)=\"未租\"Then bo1.ListIndex=1

ElseIfrs_house.Fields(8)=\"意向\"Then bo1.ListIndex=2 EndIf EndIf

'开始时设置各个text框不可写 Fori=0To7

Text1(i).Enabled=False Nexti

'先设置boBox的默认值及不可改 bo1.Enabled=False EndSub

PrivateSubcmdClose_Click() UnloadMe EndSub

删除按钮的源代码： PrivateSubcmdDel_Click()

'当单击删除记录时，需要弹出一个提示框，警告用户 DimanswerAsString

answer=MsgBox(\"确定要删除吗？\'确实删除

Ifanswer=vbYesThen rs_house.Delete'删除当前记录 rs_house.Update'更新删除

MsgBox\"成功删除！\Else ExitSub EndIf

'删除之后，显示总信息条数需要减1 Text2.Text=Val(Text2.Text)-1

'删除当前记录后，需要显示下一条记录，如果删除的是最后一条记录，则显示上一条记录 '先移动rs_house记录到后一条 rs_house.MoveNext Ifrs_house.EOFThen rs_house.MovePrevious '如果没有到记录首则显示该记录 IfNotrs_house.BOFThen Fori=0To7

Text1(i).Text=rs_house.Fields(i) Nexti

Ifrs_house.Fields(8)=\"已租\"Then bo1.ListIndex=0

ElseIfrs_house.Fields(8)=\"未租\"Then

bo1.ListIndex=1

ElseIfrs_house.Fields(8)=\"意向\"Then bo1.ListIndex=2 EndIf

'如果到记录首，则表格已经为空，置所有text框显示为空 ElseIfrs_house.BOFThen Fori=0To7 Text1(i).Text=\"\" Nexti

cmdFirst.Enabled=False cmdPrev.Enabled=False cmdNext.Enabled=False cmdLast.Enabled=False EndIf

'如果删除的不是首尾记录，则显示当前记录即可 Else Fori=0To7

Text1(i).Text=rs_house.Fields(i) Nexti

Ifrs_house.Fields(8)=\"已租\"Then bo1.ListIndex=0

ElseIfrs_house.Fields(8)=\"未租\"Then

bo1.ListIndex=1

ElseIfrs_house.Fields(8)=\"意向\"Then bo1.ListIndex=2 EndIf EndIf EndSub

保存按钮的源代码： PrivateSubcmdEdit_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框可写 Fori=1To7

Text1(i).Enabled=True

Nexti

bo1.Enabled=True add=0 EndSub

PrivateSubcmdFirst_Click() '先移动rs_house记录到第一条 rs_house.MoveFirst

'同时需要设置相应按钮为不可用和不可用 cmdPrev.Enabled=False cmdFirst.Enabled=False cmdNext.Enabled=True cmdLast.Enabled=True

'如果已经是第一条记录，则提示用户 Ifrs_house.BOF=TrueThen

MsgBox\"对不起，已经是第一条记录了！\注意\" ExitSub

'如果不是，则个数据表的记录位置移到第一条记录，并且显示之 Else Fori=0To7

Text1(i).Text=rs_house.Fields(i) Nexti

Ifrs_house.Fields(8)=\"已租\"Then

bo1.ListIndex=0

ElseIfrs_house.Fields(8)=\"未租\"Then bo1.ListIndex=1

ElseIfrs_house.Fields(8)=\"意向\"Then bo1.ListIndex=2 EndIf EndIf EndSubPREV 检索按钮的源代码：

1．2客户资料管理模块的设计 1．2．1租户基本资料的设计

运行效果图如下所示:

在租户基本资料中，我们重点分析查找家庭租户功能的源码，如下: PrivateSubcmdQuery_Click() IfText1.Text=\"\"Then

MsgBox\"查询条件不可为空！\注意\" Text1.SetFocus ExitSub EndIf

'设置查询家庭租户变量为真 querycf=True

sqlqcf=\"where\"&bo1.Text&\"=\"&\"'\"&Text1.Text&\"'\" frmClient.Show '关闭本窗体 UnloadMe EndSub

1．2．2求租户基本资料的设计

其保存按钮的源码分析如下： PrivateSubcmdSave_Click() '检测数据是否完整 IfText1(0).Text=\"\"Then

MsgBox\"求租客户编号不可为空！\注意\" Text1(0).SetFocus ExitSub

ElseIfText1(1).Text=\"\"Then

MsgBox\"求租客户姓名不可为空！\注意\" Text1(1).SetFocus ExitSub

ElseIfText1(2).Text=\"\"Then

MsgBox\"求租客户电话不可为空！\注意\" Text1(2).SetFocus ExitSub

ElseIfNotText1(4).Text=\"\"AndIsNumeric(Text1(4).Text)=FalseThen MsgBox\"面积要求不为空则应为数字！\注意\" Text1(4).SetFocus ExitSub

ElseIfNotText1(6).Text=\"\"AndIsNumeric(Text1(6).Text)=FalseThen MsgBox\"意向价位不为空则应为数字！\注意\" Text1(6).SetFocus ExitSub

ElseIfNotText1(7).Text=\"\"AndIsNumeric(Text1(7).Text)=FalseThen MsgBox\"意向租期不为空则应为数字！\注意\" Text1(7).SetFocus ExitSub EndIf

'如果意向房屋编号不为空，需要检查是否存在 IfNotText1(8).Text=\"\"Then DimsqlhcheckAsString

Dimrs_hcheckAsNewADODB.Recordset

sqlhcheck=\"select*fromHousewhere房屋编号='\"&Text1(8).Text&\"'\" rs_hcheck.Opensqlhcheck,conn,adOpenStatic,adLockOptimistic Ifrs_hcheck.EOFThen

MsgBox\"该房屋编号不存在，请重填或清空！\注意\" Text1(8).SetFocus

rs_hcheck.Close ExitSub EndIf

rs_hcheck.Close EndIf

'添加数据后保存 Ifadd=1Then

'检测房屋编号这个主键是否已经在表中存在 Dimrs_checkAsNewADODB.Recordset DimsqlCheckAsString

sqlCheck=\"select*fromQZClientwhere求租客户编号='\"&(Text1(0).Text)&\"'\" rs_check.OpensqlCheck,conn,adOpenStatic,adLockOptimistic IfNotrs_check.EOFAndNotrs_check.BOFThen

MsgBox\"该求租客户编号已经存在，请重填一个！\注意\" rs_check.Close Text1(0).SetFocus Text1(0).Text=\"\" ExitSub EndIf

rs_check.Close

'主键不重复，可以加入表中 rs_QZClient.AddNew

Fori=0To9

rs_QZClient.Fields(i)=Text1(i).Text Nexti

rs_QZClient.Update

'添加之后显示总共条数信息加1 Text2.Text=Val(Text2.Text)+1 '修改数据后的保存 Else

rs_QZClient.Update EndIf

MsgBox\"保存数据成功！\祝贺\" '保存后需要设置其他按钮可用，以及各个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 Fori=0To9

Text1(i).Enabled=False Nexti EndSub

1．3租赁管理模块的设计 1．3.1签订合同的设计

因租赁管理，财务管理和统计报表三个模块的窗体设计比较多，无法一一描述，故选择有代表性的窗体设计加以分析，其合同签订窗体的运行效果图如下: 如图所示,签订的源码设计如下: PrivateSubcmdSign_Click() '先检查输入数据完整性 Fori=0To2

IfText1(i).Text=\"\"Then

MsgBox\"除备注外的所有项不可为空！\注意\" Text1(i).SetFocus ExitSub EndIf Nexti Fori=3To4

IfText1(i).Text=\"\"OrIsDate(Text1(i).Text)=FalseThen

MsgBox\"日期应为这样的格式：2003-7-15！\注意\" Text1(i).SetFocus ExitSub EndIf Nexti

IfText1(6).Text=\"\"OrIsNumeric(Text1(6).Text)=FalseThen MsgBox\"月租金应为数字！\注意\" Text1(6).SetFocus ExitSub EndIf

IfText1(8).Text=\"\"OrIsNumeric(Text1(8).Text)=FalseThen MsgBox\"押金应为数字！\注意\" Text1(8).SetFocus ExitSub EndIf

IfText1(9).Text=\"\"Then

MsgBox\"业务员不可为空！\注意\" Text1(9).SetFocus ExitSub EndIf

IfText1(10).Text=\"\"OrIsDate(Text1(10).Text)=FalseThen

MsgBox\"签订日期应为这样的格式：2003-7-15！\注意\"

Text1(10).SetFocus ExitSub EndIf

'止租日期不能前于起租日期

IfDateValue(Text1(4).Text)MsgBox\"止租日期不能前于起租日期\注意\" Text1(4).SetFocus ExitSub EndIf

'租期等于起租日期和止租日期之差，结尾不足一月，按一月计。 '使用datediff函数计算日期之差

Text1(5).Text=Int(DateDiff(\"d\ext))/31)+1

'总租金等于月租金乘以租期

Text1(7).Text=Val(Text1(5).Text)*Val(Text1(6).Text)

'检查完数据完整性后，还需要检查该客户是否已存入租户表中，以及该房屋是否为未出租或预定状态

sqlc=\"select*fromClientwhere租户姓名='\"&Text1(1).Text&\"'\" rs_ccheck.Opensqlc,conn,adOpenStatic,adLockOptimistic Ifrs_ccheck.EOF=TrueThen rs_ccheck.Close

MsgBox\"该客户资料还未存入租户资料表中，请先录入该客户资料！

\注意\" ExitSub EndIf

rs_ccheck.Close '检测房屋状态

sqlh=\"select*fromHousewhere房屋编号='\"&Text1(2).Text&\"'\" rs_hcheck.Opensqlh,conn,adOpenStatic,adLockOptimistic Ifrs_hcheck.EOF=TrueThen

MsgBox\"该房屋编号不存在，请重新输入一个！\注意\" Text1(2).SetFocus rs_hcheck.Close ExitSub

ElseIfrs_hcheck.Fields(8)=\"已租\"Then

MsgBox\"该房屋已经出租了，请选择另一房屋！\注意\" rs_hcheck.Close ExitSub

'如果该房屋状态为预定，则需要看预定人是否为该客户，如果不是，需要弹出对话框提示用户

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,adLockOptimistic rs_contract.AddNew Fori=0To11

rs_contract.Fields(i)=Text1(i).Text Nexti

rs_contract.Update '修改房屋状态 rs_hcheck(8)=\"已租\" rs_hcheck.Update

'检查求租客户表中是否有该客户，如果有，则删除之

sqlqzc=\"select*fromQZClientwhere求租客户姓名='\"&Text1(1).Text&\"'\" rs_qzc.Opensqlqzc,conn,adOpenStatic,adLockOptimistic Ifrs_qzc.EOF=FalseThen rs_qzc.Delete rs_qzc.Update EndIf

'显示签订合同成功

MsgBox\"签订合同成功！\注意\" '设置签订按钮不可用 cmdSign.Enabled=False cmdYaJin.Enabled=True cmdZuJin.Enabled=True '关闭所有打开的记录集 rs_qzc.Close rs_yd.Close rs_hcheck.Close rs_contract.Close ExitSub Else

MsgBox\"该房屋已经被别人预定了，请选择另一房屋！\注意\"

rs_hcheck.Close rs_yd.Close ExitSub EndIf

'该客户即为预定客户，可以出租 ElseIfrs_yd.Fields(1)=Text1(1).TextThen '出租，加入合同表

sqlcon=\"select*fromContract\"

rs_contract.Opensqlcon,conn,adOpenStatic,adLockOptimistic rs_contract.AddNew Fori=0To11

rs_contract.Fields(i)=Text1(i).Text Nexti

rs_contract.Update '修改房屋状态 rs_hcheck(8)=\"已租\" rs_hcheck.Update '删除预定表中该项 rs_yd.Delete rs_yd.Update

'检查求租客户表中是否有该客户，如果有，则删除之

sqlqzc=\"select*fromQZClientwhere求租客户姓名='\"&Text1(1).Text&\"'\" rs_qzc.Opensqlqzc,conn,adOpenStatic,adLockOptimistic Ifrs_qzc.EOF=FalseThen rs_qzc.Delete rs_qzc.Update EndIf

'显示签订合同成功

MsgBox\"签订合同成功！！\注意\"

'设置签订按钮不可用 cmdSign.Enabled=False cmdYaJin.Enabled=True cmdZuJin.Enabled=True '关闭所有打开的记录集 rs_qzc.Close rs_yd.Close rs_hcheck.Close rs_contract.Close ExitSub EndIf

'如果该房屋状态为未租，则可以顺利出租 ElseIfrs_hcheck.Fields(8)=\"未租\"Then '出租，加入合同表

sqlcon=\"select*fromContract\"

rs_contract.Opensqlcon,conn,adOpenStatic,adLockOptimistic rs_contract.AddNew Fori=0To11

rs_contract.Fields(i)=Text1(i).Text Nexti

rs_contract.Update '修改房屋状态

rs_hcheck(8)=\"已租\" rs_hcheck.Update

'检查求租客户表中是否有该客户，如果有，则删除之

sqlqzc=\"select*fromQZClientwhere求租客户姓名='\"&Text1(1).Text&\"'\" rs_qzc.Opensqlqzc,conn,adOpenStatic,adLockOptimistic Ifrs_qzc.EOF=FalseThen rs_qzc.Delete rs_qzc.Update EndIf

'显示签订合同成功

MsgBox\"签订合同成功！\注意\" '设置签订按钮不可用 cmdSign.Enabled=False cmdYaJin.Enabled=True cmdZuJin.Enabled=True '关闭所有打开的记录集 rs_qzc.Close rs_hcheck.Close rs_contract.Close ExitSub EndIf

1．3.2预定租房的设计

其收取定金的设计如下： PrivateSubcmdDingJin_Click() fromYuding=True

cmdDingJin.Enabled=False frmPayDingJin.Show EndSub

1．4财务管理模块的设计 1．4.1定金收取的设计

系统维护的运行效果图如下: 其收取定金按钮的源码设计如下: PrivateSubcmdAdd_Click() '先检测数据完整性 IfText1(0).Text=\"\"Then

MsgBox\"收费编号不可为空！\注意\" Text1(0).SetFocus ExitSub EndIf

IfText1(2).Text=\"\"OrIsDate(Text1(2).Text)=FalseThen

MsgBox\"收费日期应为这样的日期格式：2003-8-3！\注意\"

Text1(2).SetFocus ExitSub EndIf

IfText1(3).Text=\"\"Then

MsgBox\"预定单编号不可为空！\注意\" Text1(3).SetFocus ExitSub EndIf

'检测该收费编号是否已存在

sqlch=\"select*fromDingJinwhere收费编号='\"&Text1(0).Text&\"'\" rs_ch.Opensqlch,conn,adOpenStatic,adLockOptimistic Ifrs_ch.EOF=FalseThen

MsgBox\"该收费编号已经存在，请重新输入一个！\注意\" Text1(0).SetFocus rs_ch.Close ExitSub EndIf rs_ch.Close

'还需要检测预定单编号是否存在、并且自动写入预定客户和预定房屋编号 sqlyd=\"select*fromYuDingwhere预定单编号='\"&Text1(3).Text&\"'\" rs_yd.Opensqlyd,conn,adOpenStatic,adLockOptimistic Ifrs_yd.EOF=TrueThen

MsgBox\"该预定单编号不存在！\注意\" rs_yd.Close Text1(3).SetFocus ExitSub Else

Text1(1).Text=rs_yd.Fields(3) Text1(4).Text=rs_yd.Fields(1) Text1(5).Text=rs_yd.Fields(2) EndIf rs_yd.Close '加入定金收费表

sqlpay=\"select*fromDingJin\"

rs_pay.Opensqlpay,conn,adOpenStatic,adLockOptimistic rs_pay.AddNew Fori=0To6

rs_pay.Fields(i)=Text1(i) Nexti

rs_pay.Update rs_pay.Close

MsgBox\"收取定金成功！\注意\" '添加完后，需要设置收取定金按钮不可用 cmdAdd.Enabled=False

EndSub

押金跟租金的收取跟定金收取的设计雷同，故不作重点描述。

1．5统计报表模块的设计

在该模块中不作按钮的源码分析

1．5．1房屋统计报表的设计

其运行图如下:

1．5．2租户信息表 1．5．3求租客户信息表 1．5．4租金统计表的设计

统计按钮的源码分析如下: PrivateSubcmdTg_Click() '统计按钮按照bo2的选择进行统计

'下面的sql语句已用户选择的bo2.text分组，并且统计同一个bo2.text的租金 sqltg=\"select\"&bo2.Text&\应交租金)as应交租金总额,sum(已交租金)as\"&_ \"已交租金总额,sum(欠费金额)as欠费总额fromZuJingroupby\"&_ bo2.Text&\"orderby\"&bo2.Text Ifrs_tg.State=adStateOpenThen rs_tg.Close EndIf

rs_tg.CursorLocation=adUseClient

rs_tg.Opensqltg,conn,adOpenStatic,adLockOptimistic '设置DataGrid2的数据源 SetDataGrid2.DataSource=rs_tg DataGrid2.Refresh EndSub

360推广http://plii8DypLu86

因篇幅问题不能全部显示，请点此查看更多更全内容

查看全文

Copyright © 2019- bangwoyixia.com 版权所有
湘ICP备2023022004号-2

Top