www.pudn.com > Pepsi_five.rar > FrmRptYearUse.frm
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