www.pudn.com > Pepsi_five.rar > FrmRptDetUse.frm
VERSION 5.00
Object = "{F0D2F211-CCB0-11D0-A316-00AA00688B10}#1.0#0"; "MSDATLST.OCX"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form FrmRptDetUse
Caption = "部门领用明细表设置"
ClientHeight = 3300
ClientLeft = 60
ClientTop = 345
ClientWidth = 5700
Icon = "FrmRptDetUse.frx":0000
LinkTopic = "Form1"
MDIChild = -1 'True
ScaleHeight = 3300
ScaleWidth = 5700
Begin MSComDlg.CommonDialog ComDlgRpt
Left = 2640
Top = 1440
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.CommandButton CmdRpt
Caption = "退出(&X)"
Height = 375
Index = 3
Left = 4320
TabIndex = 16
Top = 2520
Width = 1155
End
Begin VB.CommandButton CmdRpt
Caption = "生成报表(&T)"
Enabled = 0 'False
Height = 375
Index = 2
Left = 2820
TabIndex = 15
Top = 2520
Width = 1155
End
Begin VB.CommandButton CmdRpt
Caption = "导出报表(&E)"
Enabled = 0 'False
Height = 375
Index = 1
Left = 4320
TabIndex = 14
Top = 1920
Width = 1155
End
Begin VB.CommandButton CmdRpt
Caption = "打印设置(&P)"
Enabled = 0 'False
Height = 375
Index = 0
Left = 2820
TabIndex = 13
Top = 1920
Width = 1155
End
Begin VB.Frame Frame1
Caption = "报表日期"
Height = 675
Index = 2
Left = 2520
TabIndex = 6
Top = 720
Width = 3135
Begin VB.TextBox TxtDay
Height = 300
Left = 2040
MaxLength = 2
TabIndex = 12
Top = 240
Width = 315
End
Begin VB.TextBox TxtMonth
Height = 300
Left = 1380
MaxLength = 2
TabIndex = 11
Top = 240
Width = 315
End
Begin VB.TextBox TxtYear
Height = 300
Left = 540
MaxLength = 4
TabIndex = 10
Top = 240
Width = 495
End
Begin VB.Label Label1
Caption = "日"
Height = 195
Index = 2
Left = 2400
TabIndex = 9
Top = 300
Width = 195
End
Begin VB.Label Label1
Caption = "月"
Height = 195
Index = 1
Left = 1800
TabIndex = 8
Top = 300
Width = 195
End
Begin VB.Label Label1
Caption = "年"
Height = 195
Index = 0
Left = 1140
TabIndex = 7
Top = 300
Width = 195
End
End
Begin VB.Frame Frame1
Caption = "报表类别"
Height = 675
Index = 1
Left = 2520
TabIndex = 2
Top = 0
Width = 3135
Begin VB.OptionButton OptRptType
Caption = "年报"
Height = 195
Index = 2
Left = 2220
TabIndex = 5
Top = 300
Width = 855
End
Begin VB.OptionButton OptRptType
Caption = "月报"
Height = 195
Index = 1
Left = 1260
TabIndex = 4
Top = 300
Width = 855
End
Begin VB.OptionButton OptRptType
Caption = "日报"
Height = 195
Index = 0
Left = 300
TabIndex = 3
Top = 300
Value = -1 'True
Width = 855
End
End
Begin VB.Frame Frame1
Caption = "物品类别"
Height = 3255
Index = 0
Left = 0
TabIndex = 0
Top = 0
Width = 2475
Begin MSDataListLib.DataList DLtProType
Bindings = "FrmRptDetUse.frx":0442
Height = 3000
Left = 60
TabIndex = 1
Top = 180
Width = 2355
_ExtentX = 4154
_ExtentY = 5292
_Version = 393216
ListField = "type_name"
BoundColumn = "type_id"
Object.DataMember = "ComProType"
End
End
End
Attribute VB_Name = "FrmRptDetUse"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private cmDetUse As ADODB.Command
Private rsRpt As ADODB.Recordset
Private rsDepartment As ADODB.Recordset
Private rsExpDetUse 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 TxtDay.Enabled = False Then TxtDay.Text = ""
If TxtMonth.Enabled = False Then TxtMonth.Text = ""
If DateIsTrue(TxtYear.Text, TxtMonth.Text, TxtDay.Text) Then
Call DetUse_Rpt
If Dir(App.Path & "\xls\detuserpt.xls") <> "" Then
Kill App.Path & "\xls\detuserpt.xls"
End If
strSQL = "select * into [Excel 8.0;database=" & App.Path & _
"\xls\detuserpt.xls].detuse from temp_detuse"
rsExpDetUse.Open strSQL, DEjxc.Conjxc, adOpenStatic, adLockOptimistic
'rsExpDetUse.Close
MsgBox "文件输出到" & App.Path & "\xls\detuserpt.xls", vbInformation, "输出完毕"
strSQL = "drop table temp_detuse"
cmDetUse.CommandText = strSQL
cmDetUse.Execute
Else
MsgBox "日期错误或大于系统启用日期!", vbCritical, "报表输出错误"
End If
Case 2
If TxtDay.Enabled = False Then TxtDay.Text = ""
If TxtMonth.Enabled = False Then TxtMonth.Text = ""
If DateIsTrue(TxtYear.Text, TxtMonth.Text, TxtDay.Text) Then
Call DetUse_Rpt
RptJxc.Show
Else
MsgBox "日期错误或大于系统启用日期!", vbCritical, "报表生成错误"
End If
Case 3
Unload Me
End Select
End Sub
Private Sub DLtProType_Click()
If Me.DLtProType.BoundText <> "" Then
CmdRpt(1).Enabled = True
'CmdRpt(2).Enabled = True
strRptTyp = Me.DLtProType.Text
End If
End Sub
Private Sub Form_Load()
intNumWindows = OpenWindow(intNumWindows)
Me.Height = 3705
Me.Width = 5820
Call SetFormStu(Me, frmMain)
Set cmDetUse = New ADODB.Command
cmDetUse.ActiveConnection = DEjxc.Conjxc
cmDetUse.CommandType = adCmdText
Set rsRpt = New ADODB.Recordset
Set rsExpDetUse = New ADODB.Recordset
Set rsDepartment = DEjxc.rsComDepartment
rsDepartment.Open
TxtYear.Text = Year(dteSysDate)
TxtMonth.Text = Month(dteSysDate)
TxtDay.Text = Day(dteSysDate)
End Sub
Private Sub Form_Unload(Cancel As Integer)
intNumWindows = Closewindow(intNumWindows)
rsDepartment.Close
Set cmDetUse = Nothing
Set rsRpt = Nothing
Set rsDepartment = Nothing
Set rsExpDetUse = Nothing
End Sub
Private Sub OptRptType_Click(Index As Integer)
Select Case Index
Case 0
Me.TxtDay.Enabled = True
Me.TxtMonth.Enabled = True
Case 1
Me.TxtDay.Enabled = False
Me.TxtMonth.Enabled = True
Case 2
Me.TxtDay.Enabled = False
Me.TxtMonth.Enabled = False
End Select
End Sub
Private Sub OptRptType_KeyPress(Index As Integer, KeyAscii As Integer)
If KeyAscii = 13 Then
TxtYear.SelStart = 0
TxtYear.SelLength = Len(TxtYear.Text)
TxtYear.SetFocus
End If
End Sub
Private Sub TxtDay_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
ElseIf KeyAscii = 13 Then
CmdRpt(0).SetFocus
End If
End Sub
Private Sub TxtMonth_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
ElseIf KeyAscii = 13 Then
If TxtDay.Enabled = True Then
TxtDay.SelStart = 0
TxtDay.SelLength = Len(TxtYear.Text)
TxtDay.SetFocus
Else
CmdRpt(0).SetFocus
End If
End If
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
ElseIf KeyAscii = 13 Then
If TxtMonth.Enabled = True Then
TxtMonth.SelStart = 0
TxtMonth.SelLength = Len(TxtYear.Text)
TxtMonth.SetFocus
Else
CmdRpt(0).SetFocus
End If
End If
End Sub
Private Function DateIsTrue(strYear As String, strMonth As String, strDay As String) As Boolean
Dim strdate As String
Dim strSQL As String
If OptRptType(0).Value = True Then
strdate = strYear & "-" & strMonth & "-" & strDay
ElseIf OptRptType(1).Value = True Then
strdate = strYear & "-" & strMonth
Else
strdate = strYear & "-12"
End If
If IsDate(strdate) Then
rsRpt.Open "select * from r_parameter", DEjxc.Conjxc, adOpenStatic, adLockReadOnly
With rsRpt
.MoveFirst
If strDay <> "" Then
If CDate(strdate) >= !pass_date Then
DateIsTrue = True
Else
DateIsTrue = False
End If
Else
If CDate(Format(strdate, "yyyy-mm")) >= Format(!pass_date, "yyyy-mm") Then
DateIsTrue = True
Else
DateIsTrue = False
End If
End If
End With
rsRpt.Close
Else
DateIsTrue = False
End If
End Function
Private Sub DetUse_Rpt()
Dim strSQL As String
Dim dteDate As Date
Dim strY, strM, strD As String
strSQL = "create table temp_detuse(p_id text(8),product_name text(30)," & _
"product_model text(18),unit text(4))"
cmDetUse.CommandText = strSQL
cmDetUse.Execute
If OptRptType(0).Value = True Then
dteDate = CDate(TxtYear.Text & "-" & TxtMonth.Text & "-" & TxtDay.Text)
ElseIf OptRptType(1).Value = True Then
dteDate = CDate(TxtYear.Text & "-" & TxtMonth.Text)
ElseIf OptRptType(2).Value = True Then
dteDate = CDate(TxtYear.Text & "-12")
End If
strY = CStr(Year(dteDate))
strM = Format(CStr(Month(dteDate)), "0#")
If OptRptType(0).Value = True Then
With rsDepartment
.MoveFirst
While Not .EOF
strSQL = "alter table temp_detuse add column " & !department_name _
& " single"
cmDetUse.CommandText = strSQL
cmDetUse.Execute
strSQL = "insert into temp_detuse select p_id,sum(qty) as " & _
!department_name & " from sale_detail_b where p_id in " & _
"(select p_id from product where type_id ='" & _
Me.DLtProType.BoundText & "') and sale_id in (select " & _
"sale_id from sale_head_b where sale_rid='" & !department_id _
& "' and sale_date=cdate('" & dteDate & "')) group by p_id"
cmDetUse.CommandText = strSQL
cmDetUse.Execute
.MoveNext
Wend
End With
strRptDte = CStr(Format(dteDate, "yyyy年mm月dd日"))
strRptCap = strRptDte & strRptTyp & "日报"
ElseIf OptRptType(1).Value = True Then
With rsDepartment
.MoveFirst
While Not .EOF
strSQL = "alter table temp_detuse add column " & !department_name _
& " single"
cmDetUse.CommandText = strSQL
cmDetUse.Execute
strSQL = "insert into temp_detuse select p_id,sum(qty) as " & _
!department_name & " from sale_detail_b where p_id in " & _
"(select p_id from product where type_id ='" & _
Me.DLtProType.BoundText & "') and sale_id in (select " & _
"sale_id from sale_head_b where sale_rid='" & !department_id _
& "' and year(sale_date)=" & CInt(strY) & _
" and month(sale_date)=" & CInt(strM) & ") group by p_id"
cmDetUse.CommandText = strSQL
cmDetUse.Execute
.MoveNext
Wend
End With
strRptDte = CStr(Format(dteDate, "yyyy年mm月"))
strRptCap = strRptDte & strRptTyp & "月报"
ElseIf OptRptType(2).Value = True Then
With rsDepartment
.MoveFirst
While Not .EOF
strSQL = "alter table temp_detuse add column " & !department_name _
& " single"
cmDetUse.CommandText = strSQL
cmDetUse.Execute
strSQL = "insert into temp_detuse select p_id,sum(qty) as " & _
!department_name & " from sale_detail_b where p_id in " & _
"(select p_id from product where type_id ='" & _
Me.DLtProType.BoundText & "') and sale_id in (select " & _
"sale_id from sale_head_b where sale_rid='" & !department_id _
& "' and year(sale_date)=" & CInt(strY) & ") group by p_id"
cmDetUse.CommandText = strSQL
cmDetUse.Execute
.MoveNext
Wend
End With
strRptDte = CStr(Format(dteDate, "yyyy年"))
strRptCap = strRptDte & strRptTyp & "年报"
End If
strSQL = "select p_id"
With rsDepartment
.MoveFirst
While Not .EOF
strSQL = strSQL & ",sum(" & !department_name & ") as " & _
!department_name & "c"
.MoveNext
Wend
End With
strSQL = strSQL & " into temp_detuse2 from temp_detuse group by p_id"
cmDetUse.CommandText = strSQL
cmDetUse.Execute
strSQL = "delete from temp_detuse"
cmDetUse.CommandText = strSQL
cmDetUse.Execute
strSQL = "insert into temp_detuse select a.p_id,b.product_name," & _
"b.product_model,b.unit"
With rsDepartment
.MoveFirst
While Not .EOF
strSQL = strSQL & ",a." & !department_name & "c as " & _
!department_name
.MoveNext
Wend
End With
strSQL = strSQL & " from temp_detuse2 a,product b where a.p_id=b.p_id"
cmDetUse.CommandText = strSQL
cmDetUse.Execute
strSQL = "drop table temp_detuse2"
cmDetUse.CommandText = strSQL
cmDetUse.Execute
End Sub