dayrec.frm

VB影碟出租系统

         EndProperty
         ForeColor       =   &H80000008&
         Height          =   255
         Left            =   8880
         TabIndex        =   11
         Top             =   5640
         Width           =   615
      End
      Begin VB.Label Label9 
         Appearance      =   0  'Flat
         BackColor       =   &H80000005&
         BackStyle       =   0  'Transparent
         Caption         =   "数量："
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H80000008&
         Height          =   255
         Left            =   240
         TabIndex        =   10
         Top             =   8280
         Width           =   735
      End
      Begin VB.Label Label10 
         Appearance      =   0  'Flat
         BackColor       =   &H80000005&
         BackStyle       =   0  'Transparent
         Caption         =   "罚款："
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H80000008&
         Height          =   255
         Left            =   13320
         TabIndex        =   9
         Top             =   5640
         Width           =   735
      End
      Begin VB.Label LabelFk 
         Appearance      =   0  'Flat
         BackColor       =   &H80000005&
         BackStyle       =   0  'Transparent
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H80000008&
         Height          =   255
         Left            =   13920
         TabIndex        =   8
         Top             =   5640
         Width           =   855
      End
      Begin VB.Label LabelC 
         Appearance      =   0  'Flat
         BackColor       =   &H80000005&
         BackStyle       =   0  'Transparent
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H80000008&
         Height          =   255
         Left            =   840
         TabIndex        =   7
         Top             =   8280
         Width           =   855
      End
   End
End
Attribute VB_Name = "DayRec"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'Download by http://www.codefans.net
Option Explicit
Public mTableName As String
Dim sum As Currency
Dim Rsum As Currency
Dim Zjin As Currency
Dim FaKuan As Currency
Private Sub Command1_Click()
Dim SQL As String
Zjin = 0: Rsum = 0
sum = 0: FaKuan = 0
SQL = "select cdinfo.影碟编号,cdinfo.影碟名称,cdinfo.光碟数量,cdinfo.借出次数," _
           & "cdinfo.影碟类别,cdinfo.入店时间 from cdinfo,viplentinfo where cdinfo.影碟编号=viplentinfo.影碟编号 and viplentinfo.借碟时间=#" & DTPicker1.Value & "# "
Adodc1.RecordSource = SQL
Set DataGrid1.DataSource = Adodc1
Adodc1.Refresh
LabelVip.Caption = Adodc1.Recordset.RecordCount & " 张"
SQL = "select cdinfo.影碟编号,cdinfo.影碟名称,cdinfo.光碟数量,cdinfo.借出次数," _
           & "cdinfo.影碟类别,cdinfo.入店时间 from cdinfo,lentinfo where cdinfo.影碟编号=lentinfo.影碟编号 and lentinfo.借碟时间=#" & DTPicker1.Value & "# "
Adodc2.RecordSource = SQL
Set DataGrid2.DataSource = Adodc2
Adodc2.Refresh
LabelSum.Caption = Adodc1.Recordset.RecordCount + Adodc2.Recordset.RecordCount & " 张"
SQL = "select * from lentinfo where 借碟时间= #" & DTPicker1.Value & "#"
OpenDBFile
OpenRS (SQL)
If Not gRst.EOF Then
   gRst.MoveFirst
   Do While Not gRst.EOF
       sum = sum + gRst("所交押金")
       gRst.MoveNext
   Loop
End If
LabelYJ.Caption = sum & " 元"
CloseRS
SQL = "select cdinfo.影碟编号,cdinfo.影碟名称,cdinfo.光碟数量,cdinfo.借出次数," _
           & "cdinfo.影碟类别,cdinfo.入店时间 from cdinfo,viplentinfo where cdinfo.影碟编号=viplentinfo.影碟编号 and viplentinfo.还碟时间=#" & DTPicker1.Value & "# "
Adodc3.RecordSource = SQL
Set DataGrid3.DataSource = Adodc3
Adodc3.Refresh
LabelVipR.Caption = Adodc3.Recordset.RecordCount & " 张"
SQL = "select cdinfo.影碟编号,cdinfo.影碟名称,cdinfo.光碟数量,cdinfo.借出次数," _
           & "cdinfo.影碟类别,cdinfo.入店时间 from cdinfo,lentinfo where cdinfo.影碟编号=lentinfo.影碟编号 and lentinfo.还碟时间=#" & DTPicker1.Value & "# "
Adodc4.RecordSource = SQL
Set DataGrid4.DataSource = Adodc4
Adodc4.Refresh
LabelRCD.Caption = Adodc3.Recordset.RecordCount + Adodc4.Recordset.RecordCount & " 张"
SQL = "select * from lentinfo where 还碟时间=#" & DTPicker1.Value & "#"
OpenDBFile
OpenRS (SQL)
If Not gRst.EOF Then
   gRst.MoveFirst
   Do While Not gRst.EOF
      Rsum = Rsum + gRst("所交押金")
      Zjin = Zjin + gRst("影碟租金")
      FaKuan = FaKuan + gRst("罚款")
      gRst.MoveNext
   Loop
End If
CloseRS
LabelRYj.Caption = Rsum & " 元"
LabelZj.Caption = Zjin & " 元"
LabelFk.Caption = FaKuan & " 元"
SQL = "select * from cancellent where 退租时间=#" & DTPicker1.Value & "#"
Adodc5.RecordSource = SQL
Set DataGrid5.DataSource = Adodc5
Adodc5.Refresh
LabelC.Caption = Adodc5.Recordset.RecordCount & " 张"
End Sub

Private Sub Command2_Click()
Dim sheet As Worksheet
Dim SQL As String
Dim JD As Integer
Dim VD As Integer
Dim JL As Integer
Dim VL As Integer
Dim Sy As Integer
Dim jf As Currency
jf = 0
If LabelYJ.Caption = "" Then
   MsgBox "请先结算！", vbInformation + vbOKOnly, "警告"
   Exit Sub
End If
JD = Adodc1.Recordset.RecordCount + Adodc2.Recordset.RecordCount
VD = Adodc1.Recordset.RecordCount
JL = Adodc3.Recordset.RecordCount + Adodc4.Recordset.RecordCount
VL = Adodc3.Recordset.RecordCount
Sy = sum - Rsum
SQL = "select * from vipinfo,viptype where vipinfo.会员级别=viptype.会员级别 and 办理日期=#" & DTPicker1.Value & "#"
OpenDBFile
OpenRS (SQL)
If Not gRst.EOF Then
    gRst.MoveFirst
    Do While Not gRst.EOF
       jf = jf + gRst("会员交费")
       gRst.MoveNext
    Loop
    CloseRS
Else
    CloseRS
End If
mTableName = Format(CDate(DTPicker1.Value), "yyyymm")
SQL = "select * from menology where 表名=""" & mTableName & """"
OpenDBFile
OpenRS (SQL)
If Not gRst.EOF Then
    CloseRS
Else
    CloseRS
    SQL = "insert into menology (表名,月份)values(""" & mTableName & """,#" & Format(DTPicker1.Value, "yyyy-mm") & "#)"
    OpenDBFile
    gCon.Execute SQL
    SQL = " create table " & mTableName & "(日期 date primary key not null,今日租碟 integer,会员租碟 integer,今日还碟 integer,会员还碟 integer,会员交费 currency,剩余押金 currency,共收租金 currency,罚款 currency)"
    gCon.Execute SQL
    CloseDBFile
End If
SQL = "select 日期 from " & mTableName & " where 日期= #" & DTPicker1.Value & "#"
OpenDBFile
OpenRS (SQL)
If Not gRst.EOF Then
    MsgBox "你已经生成过" & DTPicker1.Value & "的报表，请返回！", vbInformation + vbOKOnly, "提示"
    CloseRS
    
Else
    CloseRS
    SQL = "insert into " & mTableName & "(日期,今日租碟,会员租碟,今日还碟,会员还碟,会员交费,剩余押金,共收租金,罚款)values(#" _
                                         & DTPicker1.Value & "#,""" _
                                         & JD & """,""" _
                                         & VD & """,""" & JL & """,""" & VL & """," & jf & "," _
                                         & Sy & "," & Zjin & "," & FaKuan & ")"
    OpenDBFile
    gCon.Execute SQL
    CloseDBFile
    MsgBox DTPicker1.Value & "的日报表生成成功！", vbInformation + vbOKOnly, "信息"

     SQL = "select * from " & mTableName & " where  日期= #" & DTPicker1.Value & "#"
     OpenDBFile
     OpenRS (SQL)
     gRst.MoveFirst
     Set gX = GetObject("", "excel.application")
     gX.Workbooks.Add
     Set sheet = gX.ActiveSheet
     sheet.Cells(1, 3) = DTPicker1.Value & " 日报表"
     sheet.Cells(2, 1) = "今日共租出影碟:"
     sheet.Cells(2, 2) = LabelSum.Caption
     sheet.Cells(2, 4) = "今日会员租碟："
     sheet.Cells(2, 5) = LabelVip.Caption
     sheet.Cells(4, 1) = "今日共收到押金："
     sheet.Cells(4, 2) = LabelYJ.Caption
     sheet.Cells(3, 1) = "今日总共还碟："
     sheet.Cells(3, 2) = LabelRCD.Caption
     sheet.Cells(3, 4) = "今日会员还碟："
     sheet.Cells(3, 5) = LabelVipR.Caption
     sheet.Cells(4, 4) = "今日共退押金："
     sheet.Cells(4, 5) = LabelRYj.Caption
     sheet.Cells(5, 1) = "今日共收租金："
     sheet.Cells(5, 2) = LabelZj.Caption
     sheet.Cells(5, 4) = "今日共收罚款："
     sheet.Cells(5, 5) = LabelFk.Caption
     sheet.Cells(6, 1) = "今日收到会费："
     sheet.Cells(6, 2) = jf & " 元"
     sheet.Cells(6, 4) = "今日合计金额："
     sheet.Cells(6, 5) = Sy + Zjin + FaKuan + jf & " 元"
     sheet.Columns("A:E").ColumnWidth = 15
     With sheet
        .Range(.Cells(2, 1), .Cells(6, 5)).Borders.LineStyle = xlContinuous
     End With
     gX.ActiveWorkbook.SaveAs App.Path & "\tablefile\" & DTPicker1.Value & mTableName & ".xls"
     gX.Quit
     CloseRS
End If
PrintDay.Show vbModal
End Sub

Private Sub Command3_Click()
Unload Me
End Sub

Private Sub Form_Load()
DTPicker1.Value = Date
Adodc1.ConnectionString = "provider=microsoft.jet.oledb.4.0;data source=" _
                          & App.Path & "\cdlent.mdb;Mode=ReadWrite;Persist Security Info=True;Jet OLEDB:Database Password=123456"
Adodc1.CursorLocation = adUseClient
Adodc1.CommandType = adCmdText
Adodc2.ConnectionString = "provider=microsoft.jet.oledb.4.0;data source=" _
                          & App.Path & "\cdlent.mdb;Mode=ReadWrite;Persist Security Info=True;Jet OLEDB:Database Password=123456"
Adodc2.CursorLocation = adUseClient
Adodc2.CommandType = adCmdText
Adodc3.ConnectionString = "provider=microsoft.jet.oledb.4.0;data source=" _
                          & App.Path & "\cdlent.mdb;Mode=ReadWrite;Persist Security Info=True;Jet OLEDB:Database Password=123456"
Adodc3.CursorLocation = adUseClient
Adodc3.CommandType = adCmdText
Adodc4.ConnectionString = "provider=microsoft.jet.oledb.4.0;data source=" _
                          & App.Path & "\cdlent.mdb;Mode=ReadWrite;Persist Security Info=True;Jet OLEDB:Database Password=123456"
Adodc4.CursorLocation = adUseClient
Adodc4.CommandType = adCmdText
Adodc5.ConnectionString = "provider=microsoft.jet.oledb.4.0;data source=" _
                          & App.Path & "\cdlent.mdb;Mode=ReadWrite;Persist Security Info=True;Jet OLEDB:Database Password=123456"
Adodc5.CursorLocation = adUseClient
Adodc5.CommandType = adCmdText

SkyGzForm1.Caption = Me.Caption
SkyGzForm1.hWnd = Me.hWnd
End Sub


Private Sub Form_Resize()
SkyGzForm1.Left = 0
SkyGzForm1.Top = 0
Me.Width = SkyGzForm1.Width - 5
Me.Height = SkyGzForm1.Height
Call SkyGzForm1.SetRgn(Me, 5)
End Sub

Private Sub SkyGzForm1_UnloadClick()
Unload Me
End Sub