frmrptyearuse.frm

这是一个用VB编写的“仓库管理系统”源码

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form FrmRptYearUse 
   Caption         =   "部门领用年度汇总表设置"
   ClientHeight    =   2220
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   3255
   Icon            =   "FrmRptYearUse.frx":0000
   LinkTopic       =   "Form1"
   MDIChild        =   -1  'True
   ScaleHeight     =   2220
   ScaleWidth      =   3255
   Begin MSComDlg.CommonDialog ComDlgRpt 
      Left            =   60
      Top             =   720
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.CommandButton CmdRpt 
      Caption         =   "退出(&X)"
      Height          =   375
      Index           =   3
      Left            =   1800
      TabIndex        =   6
      Top             =   1560
      Width           =   1155
   End
   Begin VB.CommandButton CmdRpt 
      Caption         =   "生成报表(&T)"
      Enabled         =   0   'False
      Height          =   375
      Index           =   2
      Left            =   300
      TabIndex        =   5
      Top             =   1560
      Width           =   1155
   End
   Begin VB.CommandButton CmdRpt 
      Caption         =   "导出报表(&E)"
      Height          =   375
      Index           =   1
      Left            =   1800
      TabIndex        =   4
      Top             =   960
      Width           =   1155
   End
   Begin VB.CommandButton CmdRpt 
      Caption         =   "打印设置(&P)"
      Enabled         =   0   'False
      Height          =   375
      Index           =   0
      Left            =   300
      TabIndex        =   3
      Top             =   960
      Width           =   1155
   End
   Begin VB.Frame Frame1 
      Caption         =   "报表日期"
      Height          =   675
      Index           =   2
      Left            =   60
      TabIndex        =   0
      Top             =   0
      Width           =   3135
      Begin VB.TextBox TxtYear 
         Height          =   300
         Left            =   960
         MaxLength       =   4
         TabIndex        =   2
         Top             =   240
         Width           =   675
      End
      Begin VB.Label Label1 
         Caption         =   "年"
         Height          =   195
         Index           =   0
         Left            =   1800
         TabIndex        =   1
         Top             =   300
         Width           =   195
      End
   End
End
Attribute VB_Name = "FrmRptYearUse"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private cmYearUse As ADODB.Command
Private rsRpt As ADODB.Recordset
Private rsDepartment As ADODB.Recordset
Private rsExpTotUse As ADODB.Recordset
Private strRptCap As String
Private strRptDte As String
Private strRptTyp As String

Private Sub CmdRpt_Click(Index As Integer)
    Dim strSQL As String
    Select Case Index
        Case 0
            ComDlgRpt.ShowPrinter
        Case 1
            If DateIsTrue(TxtYear.Text) Then
                Call TotUse_Rpt
                If Dir(App.Path & "\xls\yearuserpt.xls") <> "" Then
                    Kill App.Path & "\xls\yearuserpt.xls"
                End If
                strSQL = "select * into [Excel 8.0;database=" & App.Path & _
                "\xls\yearuserpt.xls].detuse from temp_yearuse"
                rsExpTotUse.Open strSQL, DEjxc.Conjxc, adOpenStatic, adLockOptimistic
                'rsExpTotUse.Close
                MsgBox "文件输出到" & App.Path & "\xls\yearuserpt.xls", vbInformation, "输出完毕"
                strSQL = "drop table temp_yearuse"
                cmYearUse.CommandText = strSQL
                cmYearUse.Execute
            Else
                MsgBox "日期错误或大于系统启用日期!", vbCritical, "报表输出错误"
            End If
        Case 2
            If DateIsTrue(TxtYear.Text) Then
                Call TotUse_Rpt
                RptJxc.Show
            Else
                MsgBox "日期错误或大于系统启用日期!", vbCritical, "报表生成错误"
            End If
        Case 3
            Unload Me
    End Select
End Sub

Private Sub Form_Load()
    intNumWindows = OpenWindow(intNumWindows)
    Me.Height = 2625
    Me.Width = 3375
    Call SetFormStu(Me, frmMain)
    Set cmYearUse = New ADODB.Command
    cmYearUse.ActiveConnection = DEjxc.Conjxc
    cmYearUse.CommandType = adCmdText
    Set rsRpt = New ADODB.Recordset
    Set rsExpTotUse = New ADODB.Recordset
    Set rsDepartment = DEjxc.rsComDepartment
    rsDepartment.Open
    TxtYear.Text = Year(dteSysDate)
End Sub

Private Sub Form_Unload(Cancel As Integer)
    intNumWindows = Closewindow(intNumWindows)
    rsDepartment.Close
    Set cmYearUse = Nothing
    Set rsRpt = Nothing
    Set rsDepartment = Nothing
    Set rsExpTotUse = Nothing
End Sub

Private Sub TxtYear_KeyPress(KeyAscii As Integer)
    Dim strValid As String
    strValid = "0123456789"
    If KeyAscii > 26 Then
        If InStr(strValid, Chr(KeyAscii)) = 0 Then
            KeyAscii = 0
        End If
    End If
End Sub

Private Function DateIsTrue(strYear As String) As Boolean
    Dim strdate As String
    Dim strSQL As String
        strdate = strYear & "-12"
    If IsDate(strdate) Then
        rsRpt.Open "select * from r_parameter", DEjxc.Conjxc, adOpenStatic, adLockReadOnly
        With rsRpt
            .MoveFirst
            If CDate(Format(strdate, "yyyy-mm")) >= Format(!pass_date, "yyyy-mm") Then
                DateIsTrue = True
            Else
                DateIsTrue = False
            End If
        End With
        rsRpt.Close
    Else
        DateIsTrue = False
    End If
End Function

Private Sub TotUse_Rpt()
    Dim strSQL As String
    Dim dteDate As Date
    Dim strY, strM, strD As String
    strSQL = "create table temp_yearuse(月份 text(2))"
    cmYearUse.CommandText = strSQL
    cmYearUse.Execute
    dteDate = CDate(TxtYear.Text & "-12")
    strY = CStr(Year(dteDate))
    strM = Format(CStr(Month(dteDate)), "0#")
    With rsDepartment
        .MoveFirst
        While Not .EOF
            strSQL = "alter table temp_yearuse add column " & !department_name _
            & " currency"
            cmYearUse.CommandText = strSQL
            cmYearUse.Execute
            strSQL = "insert into temp_yearuse select " & _
            "format(month(b.sale_date),'0#') as " & _
            "月份,a.price as " & !department_name & " from " & _
            "sale_detail_b a,sale_head_b b where a.sale_id=b.sale_id " & _
            "and b.sale_rid='" & !department_id & "' and year(b.sale_date)=" & _
            CInt(strY)
            cmYearUse.CommandText = strSQL
            cmYearUse.Execute
            .MoveNext
        Wend
    End With
    strRptDte = CStr(Format(dteDate, "yyyy年"))
    strRptCap = strRptDte & strRptTyp & "年报"
    strSQL = "select 月份"
    With rsDepartment
        .MoveFirst
        While Not .EOF
            strSQL = strSQL & ",sum(" & !department_name & ") as " & _
            !department_name & "c"
            .MoveNext
        Wend
    End With
    strSQL = strSQL & " into temp_yearuse2 from temp_yearuse group by 月份"
    cmYearUse.CommandText = strSQL
    cmYearUse.Execute
    strSQL = "delete from temp_yearuse"
    cmYearUse.CommandText = strSQL
    cmYearUse.Execute
    strSQL = "insert into temp_yearuse select 月份"
    With rsDepartment
        .MoveFirst
        While Not .EOF
            strSQL = strSQL & "," & !department_name & "c as " & _
            !department_name
            .MoveNext
        Wend
    End With
    strSQL = strSQL & " from temp_yearuse2 order by 月份"
    cmYearUse.CommandText = strSQL
    cmYearUse.Execute
    strSQL = "drop table temp_yearuse2"
    cmYearUse.CommandText = strSQL
    cmYearUse.Execute
End Sub