bzjwin.frm

酒店管理系统

VERSION 5.00
Object = "{50CBA22D-9024-11D1-AD8F-8E94A5273767}#8.6#0"; "TRANIMG2.OCX"
Begin VB.Form BZJWIN 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "提示信息"
   ClientHeight    =   1305
   ClientLeft      =   690
   ClientTop       =   1740
   ClientWidth     =   5400
   ControlBox      =   0   'False
   Icon            =   "BZJWIN.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   1305
   ScaleWidth      =   5400
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin VB.Timer Timer3 
      Enabled         =   0   'False
      Interval        =   30
      Left            =   3000
      Top             =   120
   End
   Begin VB.Timer Timer2 
      Interval        =   10
      Left            =   2160
      Top             =   120
   End
   Begin VB.Timer Timer1 
      Enabled         =   0   'False
      Interval        =   1
      Left            =   1320
      Top             =   120
   End
   Begin DevPowerTransImg.TransImg TransImg1 
      Height          =   495
      Left            =   8880
      TabIndex        =   0
      Top             =   680
      Width           =   1095
      _ExtentX        =   1931
      _ExtentY        =   873
      AutoSize        =   0   'False
      MaskColor       =   16777215
      Transparent     =   -1  'True
   End
End
Attribute VB_Name = "BZJWIN"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
    Dim DATJDGL As Database
    Dim RECSBZJ As Recordset
    Dim RECTBZJ As Recordset
    Dim RECYBZJ As Recordset
    Dim RECYSYJ As Recordset
    Dim RECBZJ As Recordset

Private Sub Form_Activate()
    Load BZJPREVIEW
End Sub

Private Sub Form_Load()
    Set DATJDGL = OpenDatabase(App.Path & "\DATA\JDGL.MDB")
End Sub

Private Sub Timer1_Timer()
    Timer1.Enabled = False
    Load JBBWIN1
    JBBWIN1.Show
    Timer3.Enabled = True

End Sub

Private Sub Timer2_Timer()
    Timer1.Enabled = True
    Timer2.Enabled = False

End Sub

Private Sub Timer3_Timer()
'    On Error GoTo BACKERROR

    Set RECSBZJ = DATJDGL.OpenRecordset("SELECT DISTINCTROW 散客登记表.客人ID AS 编号, 散客登记表.姓名 AS 名称, '散客保证金' AS 类型, 散客登记表.预付款, Sum(客人帐单.保证金) AS 保证金, IIf([预付款]<>0,[预付款],0)+IIf([保证金]<>0,[保证金],0) AS 金额 FROM 散客登记表 LEFT JOIN 客人帐单 ON 散客登记表.客人ID = 客人帐单.客人ID GROUP BY 散客登记表.客人ID, 散客登记表.姓名, '散客保证金', 散客登记表.预付款", dbOpenDynaset)
    Set RECTBZJ = DATJDGL.OpenRecordset("SELECT DISTINCTROW 团会登记表.团会ID AS 编号, 团会登记表.团会名称 AS 名称, '团会保证金' AS 类型, 团会登记表.预付款, Sum(客人帐单.保证金) AS 保证金, IIf([预付款]<>0,[预付款],0)+IIf([保证金]<>0,[保证金],0) AS 金额 FROM 团会登记表 LEFT JOIN 客人帐单 ON 团会登记表.团会ID = 客人帐单.团会ID GROUP BY 团会登记表.团会ID, 团会登记表.团会名称, '团会保证金', 团会登记表.预付款", dbOpenDynaset)
    Set RECYBZJ = DATJDGL.OpenRecordset("SELECT DISTINCTROW 预订单.定房卡号 AS 编号, 预订单.姓名 AS 名称, '预订金' AS 类型, 预订单.预付款 AS 金额 From 预订单 GROUP BY 预订单.定房卡号, 预订单.姓名, '预订金', 预订单.预付款 HAVING (((预订单.预付款)<>0))", dbOpenDynaset)
    Set RECYSYJ = DATJDGL.OpenRecordset("SELECT DISTINCTROW 团会登记表.团会ID AS 编号, 团会房间安排.姓名 AS 名称, '钥匙押金' AS 类型, 团会房间安排.押金 AS 金额 FROM 团会登记表 LEFT JOIN 团会房间安排 ON 团会登记表.团会ID = 团会房间安排.团会ID GROUP BY 团会登记表.团会ID, 团会房间安排.姓名, '钥匙押金', 团会房间安排.押金 HAVING (((团会房间安排.押金)<>0))", dbOpenDynaset)
    
    DATJDGL.Execute ("DELETE FROM 当前保证金")
    While Not RECSBZJ.EOF
        If RECSBZJ("金额") <> 0 Then
           MBH = RECSBZJ("编号")
           MMC = IIf(IsNull(RECSBZJ("名称")), "无名氏", RECSBZJ("名称"))
           MLX = IIf(IsNull(RECSBZJ("类型")), "", RECSBZJ("类型"))
           MJE = IIf(IsNull(RECSBZJ("金额")), "", RECSBZJ("金额"))
           DD = "'" + MBH + "','" + MMC + "','" + MLX + "'," + CStr(MJE)
           DATJDGL.Execute "INSERT INTO 当前保证金 " & "(编号,名称,类型,金额) VALUES (" & DD & ")"
        End If
        RECSBZJ.MoveNext
    Wend
    While Not RECTBZJ.EOF
        If RECTBZJ("金额") <> 0 Then
           MBH = RECTBZJ("编号")
           MMC = IIf(IsNull(RECTBZJ("名称")), "无名氏", RECTBZJ("名称"))
           MLX = IIf(IsNull(RECTBZJ("类型")), "", RECTBZJ("类型"))
           MJE = IIf(IsNull(RECTBZJ("金额")), "", RECTBZJ("金额"))
           DD = "'" + MBH + "','" + MMC + "','" + MLX + "'," + CStr(MJE)
           DATJDGL.Execute "INSERT INTO 当前保证金 " & "(编号,名称,类型,金额) VALUES (" & DD & ")"
        End If
        RECTBZJ.MoveNext
    Wend
    While Not RECYSYJ.EOF
        MBH = RECYSYJ("编号")
        MMC = IIf(IsNull(RECYSYJ("名称")), "无名氏", RECYSYJ("名称"))
        MLX = IIf(IsNull(RECYSYJ("类型")), "", RECYSYJ("类型"))
        MJE = IIf(IsNull(RECYSYJ("金额")), "", RECYSYJ("金额"))
        DD = "'" + MBH + "','" + MMC + "','" + MLX + "'," + CStr(MJE)
        DATJDGL.Execute "INSERT INTO 当前保证金 " & "(编号,名称,类型,金额) VALUES (" & DD & ")"
        RECYSYJ.MoveNext
    Wend
    While Not RECYBZJ.EOF
        MBH = RECYBZJ("编号")
        MMC = IIf(IsNull(RECYBZJ("名称")), "无名氏", RECYBZJ("名称"))
        MLX = IIf(IsNull(RECYBZJ("类型")), "", RECYBZJ("类型"))
        MJE = IIf(IsNull(RECYBZJ("金额")), "", RECYBZJ("金额"))
        DD = "'" + MBH + "','" + MMC + "','" + MLX + "'," + CStr(MJE)
        DATJDGL.Execute "INSERT INTO 当前保证金 " & "(编号,名称,类型,金额) VALUES (" & DD & ")"
        RECYBZJ.MoveNext
    Wend
    Set RECBZJ = DATJDGL.OpenRecordset("当前保证金", dbOpenDynaset)
    If RECBZJ.RecordCount = 0 Then
       Unload JBBWIN1
       MsgBox "经查无保证金明细记录!", vbInformation, "提示信息"
       Unload Me
       Exit Sub
    End If
    RECBZJ.MoveLast
    If RECBZJ.RecordCount Mod 22 <> 0 Then
       For A = 1 To 22 - RECBZJ.RecordCount Mod 22 Step 1
           RECBZJ.AddNew
           RECBZJ.Update
       Next A
    End If
    RECBZJ.Requery
    RECBZJ.MoveLast
    c = RECBZJ.RecordCount
    RECBZJ.MoveFirst
    For A = 1 To c / 22 Step 1
        For b = 1 To 22 Step 1
            MYMARK = RECBZJ.Bookmark
            RECBZJ.Edit
            RECBZJ("页码") = A
            RECBZJ.Update
            RECBZJ.Bookmark = MYMARK
            If RECBZJ.EOF Then
               Exit For
               Else
                 RECBZJ.MoveNext
            End If
        Next b
    Next A
    Unload JBBWIN1
    BZJPREVIEW.Show vbModal
    Unload Me
    Exit Sub
    
BACKERROR:
    If Err.Number = 3704 Then
       Resume Next
       Else
         MsgBox CStr(Err.Number) & "-" & Err.Description, vbCritical, "错误信息"
         Unload Me
    End If

End Sub