📄 dayrec.frm
字号:
MaxRecords = 0
BOFAction = 0
EOFAction = 0
ConnectStringType= 1
Appearance = 1
BackColor = -2147483643
ForeColor = -2147483640
Orientation = 0
Enabled = -1
Connect = ""
OLEDBString = ""
OLEDBFile = ""
DataSourceName = ""
OtherAttributes = ""
UserName = ""
Password = ""
RecordSource = ""
Caption = "Adodc2"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
_Version = 393216
End
End
Begin VB.Label LabelYj
AutoSize = -1 'True
ForeColor = &H000000FF&
Height = 180
Left = 4800
TabIndex = 13
Top = 2040
Width = 90
End
Begin VB.Label LabelVip
AutoSize = -1 'True
ForeColor = &H000000FF&
Height = 180
Left = 4800
TabIndex = 12
Top = 1320
Width = 90
End
Begin VB.Label LabelSum
AutoSize = -1 'True
ForeColor = &H000000FF&
Height = 180
Left = 4800
TabIndex = 11
Top = 600
Width = 90
End
Begin VB.Label Label4
Caption = "共收押金："
Height = 375
Left = 3720
TabIndex = 10
Top = 2040
Width = 975
End
Begin VB.Label Label3
Caption = "会员借影碟："
Height = 375
Left = 3720
TabIndex = 9
Top = 1320
Width = 1095
End
Begin VB.Label Label2
Caption = "共借出影碟："
Height = 375
Left = 3720
TabIndex = 8
Top = 600
Width = 1095
End
End
Begin VB.Frame Frame1
Height = 855
Left = 120
TabIndex = 0
Top = 120
Width = 11175
Begin VB.CommandButton Command3
Caption = "关闭"
Height = 375
Left = 9480
TabIndex = 31
Top = 240
Width = 1455
End
Begin VB.CommandButton Command2
Caption = "生成报表"
Height = 375
Left = 7800
TabIndex = 30
Top = 240
Width = 1455
End
Begin VB.CommandButton Command1
Caption = "开始结算"
Height = 375
Left = 6120
TabIndex = 3
Top = 240
Width = 1455
End
Begin MSComCtl2.DTPicker DTPicker1
Height = 375
Left = 1800
TabIndex = 2
Top = 240
Width = 1695
_ExtentX = 2990
_ExtentY = 661
_Version = 393216
CalendarTitleBackColor= -2147483646
Format = 49610753
CurrentDate = 38122
End
Begin VB.Label Label1
Caption = "选择结算的日期："
Height = 375
Left = 360
TabIndex = 1
Top = 360
Width = 1455
End
End
End
Attribute VB_Name = "DayRec"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
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=vcdglxt"
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=vcdglxt"
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=vcdglxt"
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=vcdglxt"
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=vcdglxt"
Adodc5.CursorLocation = adUseClient
Adodc5.CommandType = adCmdText
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -