📄 monthtable.frm
字号:
VERSION 5.00
Object = "{BDF6FCF6-E2A0-4DA6-8DF8-FA27594705C8}#26.1#0"; "XPControls.ocx"
Object = "{2D8BCEE7-021A-4575-99B6-5E26BF8B6DEE}#1.0#0"; "Form32.ocx"
Begin VB.Form MonthTable
BackColor = &H00FFFFFF&
BorderStyle = 0 'None
Caption = "每月结算"
ClientHeight = 7920
ClientLeft = 0
ClientTop = 105
ClientWidth = 9495
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 7920
ScaleWidth = 9495
ShowInTaskbar = 0 'False
StartUpPosition = 2 '屏幕中心
Begin Form32.SkyGzForm SkyGzForm1
Height = 7935
Left = 0
TabIndex = 0
Top = 0
Width = 9495
_ExtentX = 16748
_ExtentY = 13996
Icon = "MonthTable.frx":0000
Begin XPControls.XPButton Command3
Height = 375
Left = 7080
TabIndex = 6
Top = 680
Width = 1095
_ExtentX = 1931
_ExtentY = 661
Caption = "取消 "
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin XPControls.XPButton Command2
Height = 375
Left = 5160
TabIndex = 5
Top = 680
Width = 1095
_ExtentX = 1931
_ExtentY = 661
Caption = "打印报表 "
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin XPControls.XPButton Command1
Height = 375
Left = 3000
TabIndex = 4
Top = 680
Width = 1215
_ExtentX = 2143
_ExtentY = 661
Caption = "生成报表 "
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin VB.ComboBox Combo1
BackColor = &H00FFFFFF&
Height = 300
ItemData = "MonthTable.frx":01DA
Left = 1200
List = "MonthTable.frx":01DC
TabIndex = 1
Text = "请选择月份"
Top = 720
Width = 1575
End
Begin VB.Label Label1
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 = 3
Top = 720
Width = 975
End
Begin VB.OLE OLE1
Appearance = 0 'Flat
Height = 6375
Left = 240
TabIndex = 2
Top = 1320
Width = 9015
End
End
End
Attribute VB_Name = "MonthTable"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'Download by http://www.codefans.net
Option Explicit
Private Sub Combo1_Change()
Combo1.Text = ""
End Sub
Private Sub Command1_Click()
On Error Resume Next
Dim SQL As String
Dim nTableName As String
Dim sheet As Worksheet
Dim LCD As Integer: Dim Vipcd As Integer: Dim Bcd As Integer: Dim VipBcd As Integer
Dim Syj As Currency: Dim Zj As Currency: Dim FaKuan As Currency: Dim VIPJF As Currency
Dim CDdel As Integer: Dim CYj As Currency: Dim Gain As Currency
LCD = 0: Vipcd = 0: Bcd = 0: VipBcd = 0: Syj = 0: Zj = 0: FaKuan = 0: VIPJF = 0: CDdel = 0: CYj = 0: Gain = 0
If Combo1.Text = "" Then
MsgBox "请你选择月份！", vbInformation + vbOKOnly, "提示"
Combo1.SetFocus
Exit Sub
End If
nTableName = Format(Combo1.Text, "yyyymm")
SQL = "select * from monthtable where 月报= """ & nTableName & """"
OpenDBFile
OpenRS (SQL)
If gRst.EOF Then
CloseRS
SQL = "select * from " & nTableName & " "
OpenDBFile
OpenRS (SQL)
If Not gRst.EOF Then
gRst.MoveFirst
Do While Not gRst.EOF
LCD = LCD + gRst("今日租碟")
Vipcd = Vipcd + gRst("会员租碟")
Bcd = Bcd + gRst("今日还碟")
VipBcd = VipBcd + gRst("会员还碟")
VIPJF = VIPJF + gRst("会员交费")
Syj = Syj + gRst("剩余押金")
Zj = Zj + gRst("共收租金")
FaKuan = FaKuan + gRst("罚款")
gRst.MoveNext
Loop
End If
CloseRS
SQL = "select *from scrapcd where 报废日期= #" & Format(Combo1.Text, "yyyy-mm-dd") & "#"
OpenDBFile
OpenRS (SQL)
If Not gRst.EOF Then
gRst.MoveFirst
Do While Not gRst.EOF
CDdel = CDdel + 1
CYj = CYj + gRst("回收押金")
gRst.MoveNext
Loop
End If
CloseRS
Gain = Zj + FaKuan + VIPJF + CYj
SQL = "insert into monthtable(月报,出租影碟,会员租影碟,返还影碟,会员返还影碟,剩余押金,收到租金,会员交费,罚款,报废碟片,回收押金,本月盈余)values(""" _
& nTableName & """,""" & LCD & """,""" & Vipcd & """,""" _
& Bcd & """,""" & VipBcd & """," & Syj & "," & Zj & "," _
& VIPJF & "," & FaKuan & ",""" & CDdel & """," & CYj & "," & Gain & ")"
OpenDBFile
gCon.Execute SQL
CloseDBFile
MsgBox "月报表生成成功！", vbInformation + vbOKOnly, "提示"
Else
CloseRS
End If
SQL = "select * from monthtable where 月报=""" & nTableName & """"
OpenDBFile
OpenRS (SQL)
If Not gRst.EOF Then
Set gX = GetObject("", "excel.application")
gX.Workbooks.Add
OLE1.Visible = True
Set sheet = gX.ActiveSheet
sheet.Cells(1, 3) = Combo1.Text & "月报表"
sheet.Cells(2, 1) = "本月共租出影碟:"
sheet.Cells(2, 2) = gRst("出租影碟") & " 张"
sheet.Cells(2, 4) = "本月会员租碟："
sheet.Cells(2, 5) = gRst("会员租影碟") & " 张"
sheet.Cells(3, 1) = "本月总共还碟："
sheet.Cells(3, 2) = gRst("返还影碟") & " 张"
sheet.Cells(3, 4) = "本月会员还碟："
sheet.Cells(3, 5) = gRst("会员返还影碟") & " 张"
sheet.Cells(4, 1) = "本月剩余押金："
sheet.Cells(4, 2) = gRst("剩余押金") & " 元"
sheet.Cells(4, 4) = "本月共收租金："
sheet.Cells(4, 5) = gRst("收到租金") & " 元"
sheet.Cells(5, 1) = "本月共收会费："
sheet.Cells(5, 2) = gRst("会员交费") & " 元"
sheet.Cells(5, 4) = "本月共收罚款："
sheet.Cells(5, 5) = gRst("罚款") & " 元"
sheet.Cells(6, 1) = "回收押金情况"
sheet.Cells(7, 1) = "本月报废影碟："
sheet.Cells(7, 2) = gRst("报废碟片") & " 张"
sheet.Cells(7, 4) = "回收押金："
sheet.Cells(7, 5) = gRst("回收押金") & " 元"
sheet.Cells(8, 1) = "本月收益汇总"
sheet.Cells(9, 1) = "本月余额："
sheet.Cells(9, 2) = gRst("剩余押金") + gRst("本月盈余") & " 元"
sheet.Cells(9, 4) = "本月盈余："
sheet.Cells(9, 5) = gRst("本月盈余") & " 元"
sheet.Columns("A:E").ColumnWidth = 15
With sheet
.Range(.Cells(2, 1), .Cells(9, 5)).Borders.LineStyle = xlContinuous
End With
gX.ActiveWorkbook.SaveAs App.Path & "\Montablefile\" & Combo1.Text & nTableName & ".xls"
OLE1.CreateLink App.Path & "\Montablefile\" & Combo1.Text & nTableName & ".xls"
End If
CloseRS
End Sub
Private Sub Command2_Click()
Dim sheet As Worksheet
Set sheet = gX.ActiveSheet
sheet.PrintOut
End Sub
Private Sub Command3_Click()
On Error Resume Next
gX.Application.Quit
Unload Me
End Sub
Private Sub Form_Load()
Dim SQL As String
SQL = "SELECT * FROM menology"
OpenDBFile
OpenRS (SQL)
If Not gRst.EOF Then
gRst.MoveFirst
Do While Not gRst.EOF
Combo1.AddItem Format(gRst("月份"), "yyyy-mm")
gRst.MoveNext
Loop
End If
CloseRS
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
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -