frmlease.frm

一个较为完整的汽车租赁业的VB管理系统源码。

  With MyLease
    .Status = "续租审核"
    .UpdateStatus (Trim(Adodc1.Recordset.Fields(0)))
  End With
  GridRefresh  '更改记录状态
End Sub

Private Sub Cmd_Exit_Click()
  Unload Me
End Sub

Private Sub Cmd_Modi_Click()
  If Adodc1.Recordset.EOF Then
    MsgBox ("请选择记录")
    Exit Sub
  End If
  '修改租赁信息
  FrmLeaseEdit.Modify = True
  FrmLeaseEdit.ContractNo = Trim(Adodc1.Recordset.Fields(0))
  FrmLeaseEdit.sCarNo = Trim(Adodc1.Recordset.Fields(1))
  FrmLeaseEdit.sCustId = Trim(Adodc1.Recordset.Fields(2))
  FrmLeaseEdit.txtContractNo = Trim(Adodc1.Recordset.Fields(0))
  FrmLeaseEdit.txtCarNo = Trim(Adodc1.Recordset.Fields(1))
  FrmLeaseEdit.txtCustId = Trim(Adodc1.Recordset.Fields(2))
  FrmLeaseEdit.cob_Mode.Text = Trim(Adodc1.Recordset.Fields(4))
  FrmLeaseEdit.txtLeaseTime = Trim(Adodc1.Recordset.Fields(3))
  FrmLeaseEdit.txtReturnTime = Trim(Adodc1.Recordset.Fields(5))
  '提取租赁信息
  If MyLease.GetInfo(Trim(Adodc1.Recordset.Fields(0))) = True Then
    FrmLeaseEdit.txtWorkDays.Enabled = True
    FrmLeaseEdit.Label13.Enabled = True
    FrmLeaseEdit.Label14.Enabled = True
    '根据租赁模式计算租赁费用
    If Trim(MyLease.LeaseMode) = "日" Then
      FrmLeaseEdit.txtWorkDays = MyLease.WorkDays
      FrmLeaseEdit.txtWeekEndCount = MyLease.WeekEndCount
      '根据租赁模式设置某些字段不可见
      FrmLeaseEdit.txtWeekEndCount.Enabled = True
      FrmLeaseEdit.Label13.Caption = "工作日"
      FrmLeaseEdit.Label19.Enabled = True
      FrmLeaseEdit.Label20.Enabled = True
    ElseIf Trim(MyLease.LeaseMode) = "周" Then
      FrmLeaseEdit.txtWorkDays = MyLease.WorkDays
      FrmLeaseEdit.txtWeekEndCount = 0
      FrmLeaseEdit.txtWeekEndCount.Enabled = False
      FrmLeaseEdit.Label13.Caption = "周数"
      FrmLeaseEdit.Label19.Enabled = False
      FrmLeaseEdit.Label20.Enabled = False
    ElseIf Trim(MyLease.LeaseMode) = "月" Then
      FrmLeaseEdit.txtWorkDays = MyLease.WorkDays
      FrmLeaseEdit.txtWeekEndCount = 0
      FrmLeaseEdit.txtWeekEndCount.Enabled = False
      FrmLeaseEdit.Label13.Caption = "月份数"
      FrmLeaseEdit.Label19.Enabled = False
      FrmLeaseEdit.Label20.Enabled = False
    End If
    FrmLeaseEdit.txtOutKM = MyLease.OutKM
    FrmLeaseEdit.txtCost = MyLease.Total
    FrmLeaseEdit.txtUserName = Trim(MyLease.UserName)
  End If
  
  FrmLeaseEdit.CarRefresh
  FrmLeaseEdit.CarPriceRefresh
  FrmLeaseEdit.CustomerRefresh

  FrmLeaseEdit.Show 1
  GridRefresh
End Sub

Private Sub Cmd_Check_Click()
  '审核后合同成立，不能修改和删除
  '更新合同状态为出租审核
  If Adodc1.Recordset.EOF = True Then
    MsgBox "请选择记录"
    Exit Sub
  End If
  If MsgBox("是否审核确认了租赁合同", vbYesNo, "请确认") = vbNo Then
    Exit Sub
  End If
  MyLease.Status = "出租审核"
  MyLease.UpdateStatus (Adodc1.Recordset.Fields(0))
  GridRefresh
End Sub

Private Sub Cmd_Del_Click()
  If Adodc1.Recordset.EOF = True Then
    MsgBox "请选择记录"
    Exit Sub
  End If
  If MsgBox("是否确定要删除租赁信息", vbYesNo, "请确认") = vbNo Then
    Exit Sub
  End If
  MyLease.Delete (Adodc1.Recordset.Fields(0))
  GridRefresh
End Sub

Private Sub Cmd_Print_Click()
  If Adodc1.Recordset.EOF = True Then
    MsgBox "请选择打印的合同"
    Exit Sub
  End If
  '按照指定格式打印合同文档Contract.doc
  Dim wdoc As Object
  Dim wapp As Object
  Dim mytable As Object
  Dim arow As Object
  Dim wordfile As String
  
  wordfile = "Contract.doc"  '文档名称
  If Dir(wordfile) = "" Then  '判断文件是否存在
    MsgBox "打印文件Contract.doc丢失，请与管理员联系"
    Exit Sub
  End If
  '启动应用程序
  Set wdoc = CreateObject("Word.Application")
  wdoc.Visible = True    '打印过程可见
  '打开Contract.doc文件
  Call wdoc.Documents.Open(App.Path + "\" + wordfile, ReadOnly:=True, Revert:=True)
  '定义第一个表格对象
  Set mytable = wdoc.ActiveDocument.Tables(1)
  '读取租赁信息
  MyLease.GetInfo (Trim(Adodc1.Recordset.Fields(0)))
  '读写合同编号
  mytable.Cell(2, 1).Range.Delete
  mytable.Cell(2, 1).Range.InsertAfter "合同编号：" + Trim(Adodc1.Recordset.Fields(0))
  '合同打印时间
  mytable.Cell(2, 2).Range.Delete
  mytable.Cell(2, 2).Range.InsertAfter "打印时间：" + Trim(Str(Now))
  '合同甲方
  mytable.Cell(3, 2).Range.Delete
  mytable.Cell(3, 2).Range.InsertAfter "      汽车租赁公司"
  
  '输出汽车信息
  Set mytable = wdoc.ActiveDocument.Tables(2)
  '读写汽车信息
  MyCar.GetInfo (Trim(MyLease.CarNo))
  mytable.Cell(1, 2).Range.InsertAfter Trim(MyLease.CarNo)  '车牌号
  mytable.Cell(1, 4).Range.InsertAfter Trim(MyCar.CarName)  '车辆名称
  '读取车辆类型名称
  mytable.Cell(2, 2).Range.InsertAfter Trim(MyType.GetTypeNames(Trim(Str(MyCar.TypeId))))  '车辆类型名称
  mytable.Cell(2, 4).Range.InsertAfter Trim(MyCar.Color)    '车辆颜色
  mytable.Cell(3, 2).Range.InsertAfter Trim(MyCar.EngineNo) '发动机号
  mytable.Cell(3, 4).Range.InsertAfter Trim(MyCar.CarCase)  '车架号
  mytable.Cell(4, 2).Range.InsertAfter Trim(MyCar.TypeId)  '保险单号
  mytable.Cell(4, 4).Range.InsertAfter Trim(MyType.GetTypeNames(Trim(MyCar.InsurType)))    '保险类型
  mytable.Cell(5, 2).Range.InsertAfter Trim(MyCar.InsurSdate)  '保险开始时间
  mytable.Cell(5, 4).Range.InsertAfter Trim(MyCar.InsurEdate)   '保险结束时间

  '收费标准
  Set mytable = wdoc.ActiveDocument.Tables(3)
  mytable.Cell(1, 2).Range.InsertAfter Trim(Str(MyLease.Deposit))   '押金
  mytable.Cell(1, 4).Range.InsertAfter Trim(Str(MyCar.DayKM))       '日限公里
  '读取车辆类型名称
  sMode = Trim(MyLease.LeaseMode)
  mytable.Cell(2, 2).Range.InsertAfter sMode                        '租赁模式
  mytable.Cell(2, 4).Range.InsertAfter Trim(Str(MyLease.OPrice2))   '超时价格（元/小时）
  mytable.Cell(3, 2).Range.InsertAfter Trim(Str(MyLease.Price1))    '价格
  mytable.Cell(3, 4).Range.InsertAfter Trim(Str(MyLease.OPrice1))   '超公里价格（元/公里）
  mytable.Cell(4, 2).Range.InsertAfter Trim(Str(MyLease.WorkDays))  '租赁数量
  mytable.Cell(4, 4).Range.InsertAfter Trim(Str(MyLease.Rate))      '折扣
  
  '根据租赁模式显示汉字
  mytable.Cell(3, 1).Range.Delete
  mytable.Cell(4, 1).Range.Delete
  If sMode = "日" Then
    mytable.Cell(3, 1).Range.InsertAfter "每日租金（元/日）"          '价格（元/日）
    mytable.Cell(4, 1).Range.InsertAfter "租赁天数（工作日）"         '租赁天数
    mytable.Cell(5, 2).Range.InsertAfter Trim(Str(MyLease.Price2))    '价格（元/周末）
    mytable.Cell(5, 4).Range.InsertAfter Trim(Str(MyLease.WeekEndCount))    '周末个数
  ElseIf sMode = "周" Then
    mytable.Cell(3, 1).Range.InsertAfter "每周租金（元/周）"    '价格（元/周）
    mytable.Cell(4, 1).Range.InsertAfter "租赁周数"             '租赁周数
    mytable.Cell(5, 1).Range.Delete
    '删除此行
    mytable.Rows(5).Select
    wdoc.Selection.Cut
  ElseIf sMode = "月" Then
    mytable.Cell(3, 1).Range.InsertAfter "每月租金（元/月）"    '价格（元/月）
    mytable.Cell(4, 1).Range.InsertAfter "租赁月数"             '租赁月数
    '删除此行
    mytable.Rows(5).Select
    wdoc.Selection.Cut
  End If
  
  '读取客户信息
  MyCustomer.GetInfo (Trim(MyLease.CustId))
  Set mytable = wdoc.ActiveDocument.Tables(4)
  mytable.Cell(1, 2).Range.InsertAfter Trim(MyLease.CustId)         '客户编号
  mytable.Cell(1, 4).Range.InsertAfter Trim(MyCustomer.Name)        '姓名
  mytable.Cell(2, 2).Range.InsertAfter Trim(MyCustomer.Sex)         '性别
  mytable.Cell(2, 4).Range.InsertAfter Trim(Str(MyCustomer.Age))    '年龄
  mytable.Cell(3, 2).Range.InsertAfter Trim(MyCustomer.IdCard)      '身份证号
  mytable.Cell(3, 4).Range.InsertAfter Trim(MyCustomer.Telephone)   '联系电话
  mytable.Cell(4, 2).Range.InsertAfter Trim(MyCustomer.WorkPlace)   '工作单位
  mytable.Cell(4, 4).Range.InsertAfter Trim(MyCustomer.Address)     '地址
  mytable.Cell(5, 2).Range.InsertAfter Trim(MyCustomer.LicenseNo)   '驾驶证号
  mytable.Cell(5, 4).Range.InsertAfter Trim(MyCustomer.LicenseType) '驾照类型
  mytable.Cell(6, 2).Range.InsertAfter Trim(MyCustomer.GetDate)     '发证日期
  mytable.Cell(6, 4).Range.InsertAfter Trim(MyCustomer.ExpiredDate) '过期日期
  mytable.Cell(7, 2).Range.InsertAfter Trim(MyCustomer.Certificate) '抵押证件
  mytable.Cell(7, 4).Range.InsertAfter Trim(MyCustomer.Warrantor)   '担保人姓名
  mytable.Cell(8, 2).Range.InsertAfter Trim(MyCustomer.WIdCard)     '担保人身份证号
  mytable.Cell(8, 4).Range.InsertAfter Trim(MyCustomer.WWorkPlace)  '担保人工作单位

  '读取租赁信息
  MyCustomer.GetInfo (Trim(MyLease.CustId))
  Set mytable = wdoc.ActiveDocument.Tables(5)
  mytable.Cell(1, 2).Range.InsertAfter Trim(MyLease.LeaseTime)      '租赁时间
  mytable.Cell(1, 4).Range.InsertAfter Trim(MyLease.ReturnTime)     '应归还时间
  mytable.Cell(2, 2).Range.InsertAfter Trim(Str(MyLease.OutKM))     '出车公里数
  '打印合同文档
  wdoc.ActiveDocument.PrintOut
  MsgBox "打印作业已提交，打印完成后按 确定 结束"
  wdoc.Quit (0)       '退出Word
  Set wdoc = Nothing  '清空内存
End Sub

Private Sub cob_Status_Click()
  GridRefresh
End Sub

'根据记录的当前状态指定操作按钮的可用性
Private Sub DataGrid1_RowColChange(LastRow As Variant, ByVal LastCol As Integer)
  If Trim(Adodc1.Recordset.Fields(6)) = "出租" Then
    Cmd_Modi.Enabled = True
    Cmd_Del.Enabled = True
    Cmd_Check.Enabled = True
    Cmd_Cont.Enabled = False
    Cmd_ContCheck.Enabled = False
    Cmd_Print.Enabled = False
  ElseIf Trim(Adodc1.Recordset.Fields(6)) = "出租审核" Then
    Cmd_Modi.Enabled = False
    Cmd_Del.Enabled = False
    Cmd_Check.Enabled = False
    Cmd_Cont.Enabled = True
    Cmd_ContCheck.Enabled = False
    Cmd_Print.Enabled = True
  ElseIf Trim(Adodc1.Recordset.Fields(6)) = "续租" Then  '续租修改也是使用这个按钮
    Cmd_Modi.Enabled = False
    Cmd_Del.Enabled = False
    Cmd_Check.Enabled = False
    Cmd_Cont.Enabled = True
    Cmd_ContCheck.Enabled = True
    Cmd_Print.Enabled = False
  ElseIf Trim(Adodc1.Recordset.Fields(6)) = "续租审核" Then
    Cmd_Modi.Enabled = False
    Cmd_Del.Enabled = False
    Cmd_Check.Enabled = False
    Cmd_Cont.Enabled = False
    Cmd_ContCheck.Enabled = False
    Cmd_Print.Enabled = True
  ElseIf Trim(Adodc1.Recordset.Fields(6)) = "归还" Then
    Cmd_Modi.Enabled = False
    Cmd_Del.Enabled = False
    Cmd_Check.Enabled = False
    Cmd_Cont.Enabled = False
    Cmd_ContCheck.Enabled = False
    Cmd_Print.Enabled = False
  ElseIf Trim(Adodc1.Recordset.Fields(6)) = "归还审核" Then
    Cmd_Modi.Enabled = False
    Cmd_Del.Enabled = False
    Cmd_Check.Enabled = False
    Cmd_Cont.Enabled = False
    Cmd_ContCheck.Enabled = False
    Cmd_Return.Enabled = False
    Cmd_Print.Enabled = True
  End If
End Sub

Private Sub Form_Load()
  GridRefresh   '刷新数据
  '加载状态名称
  cob_Status.AddItem "出租", 0
  cob_Status.AddItem "出租审核", 1
  cob_Status.AddItem "续租", 2
  cob_Status.AddItem "续租审核", 3
  cob_Status.AddItem "归还", 4
  cob_Status.AddItem "归还审核", 5
  '设置部分按钮不可用
  Cmd_Modi.Enabled = False      '修改
  Cmd_Del.Enabled = False       '删除
  Cmd_Check.Enabled = False     '租赁审核
  Cmd_Cont.Enabled = False      '续租
  Cmd_ContCheck.Enabled = False '续租审核
  Cmd_Print.Enabled = False     '打印合同
End Sub
Private Sub GridRefresh()
  '按照选择的租赁状态查找记录
  If Trim(cob_Status.Text) = "" Or Trim(cob_Status.Text) = "全部" Then
    SchCnd = ""
  Else
    SchCnd = " AND Status='" + Trim(cob_Status.Text) + "'"
  End If
  Adodc1.ConnectionString = Conn  '设置连接字符串
  Adodc1.RecordSource = "SELECT ContractNo AS 合同编号,CarNo AS 车牌号," _
    + "CustId AS 客户号,LeaseTime AS 租赁时间,LeaseMode AS 租赁模式, " _
    + "ReturnTime AS 归还时间,Status AS 状态," _
    + "IIF([Status]='日',Price1*WorkDays+Price2*WeekEndCount,Price1*WorkDays) AS 租车费用," _
    + "OtherCost AS 其他费用,Payment AS 实际支付,Deposit AS 押金,Total AS 总额 " _
    + " FROM Lease WHERE Status NOT IN ('归还','结算审核') " + SchCnd _
    + " ORDER BY ReturnTime DESC,LeaseTime DESC"
  Adodc1.Refresh
  Set DataGrid1.DataSource = Adodc1   '设置数据源
  DataGrid1.Columns(0).Width = 1000   '表格列宽度设置
  DataGrid1.Columns(1).Width = 1000
  DataGrid1.Columns(2).Width = 1000
  DataGrid1.Columns(3).Width = 1800
  DataGrid1.Columns(4).Width = 1000
  DataGrid1.Columns(5).Width = 1800
  DataGrid1.Columns(6).Width = 1000
  DataGrid1.Columns(7).Width = 1000
  DataGrid1.Columns(8).Width = 1000
  DataGrid1.Columns(9).Width = 1000
  DataGrid1.Columns(10).Width = 1000
  DataGrid1.Columns(11).Width = 1000
End Sub