monthtable.frm

VB+ACCESS2000编写的VCD出租管理系统

VERSION 5.00
Begin VB.Form MonthTable 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "月报表"
   ClientHeight    =   7620
   ClientLeft      =   45
   ClientTop       =   435
   ClientWidth     =   9240
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MDIChild        =   -1  'True
   ScaleHeight     =   7620
   ScaleWidth      =   9240
   Begin VB.Frame Frame1 
      Height          =   855
      Left            =   120
      TabIndex        =   1
      Top             =   6600
      Width           =   9015
      Begin VB.CommandButton Command3 
         Caption         =   "关闭"
         Height          =   375
         Left            =   7320
         TabIndex        =   6
         Top             =   240
         Width           =   1575
      End
      Begin VB.CommandButton Command2 
         Caption         =   "打印报表"
         Height          =   375
         Left            =   5520
         TabIndex        =   5
         Top             =   240
         Width           =   1575
      End
      Begin VB.CommandButton Command1 
         Caption         =   "生成报表"
         Height          =   375
         Left            =   3720
         TabIndex        =   4
         Top             =   240
         Width           =   1575
      End
      Begin VB.ComboBox Combo1 
         BackColor       =   &H00C0FFFF&
         Height          =   300
         Left            =   1320
         TabIndex        =   3
         Top             =   240
         Width           =   1575
      End
      Begin VB.Label Label1 
         Caption         =   "选择月份："
         Height          =   255
         Left            =   360
         TabIndex        =   2
         Top             =   360
         Width           =   975
      End
   End
   Begin VB.OLE OLE1 
      Height          =   6375
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   9015
   End
End
Attribute VB_Name = "MonthTable"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
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
End Sub