?? frmrpttotuse.frm
字號:
Private Sub Form_Unload(Cancel As Integer)
intNumWindows = Closewindow(intNumWindows)
rsDepartment.Close
Set cmTotUse = Nothing
Set rsRpt = Nothing
Set rsDepartment = Nothing
Set rsExpTotUse = 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 TotUse_Rpt()
Dim strSQL As String
Dim dteDate As Date
Dim strY, strM, strD As String
strSQL = "create table temp_totuse(物品類別編號 text(2),物品類別名稱 text(20))"
cmTotUse.CommandText = strSQL
cmTotUse.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_totuse add column " & !department_name _
& " currency"
cmTotUse.CommandText = strSQL
cmTotUse.Execute
strSQL = "insert into temp_totuse select left(p_id,2) as " & _
"物品類別編號,price as " & !department_name & " from " & _
"sale_detail_b where sale_id in (select sale_id from " & _
"sale_head_b where sale_rid='" & !department_id _
& "' and sale_date=cdate('" & dteDate & "'))"
cmTotUse.CommandText = strSQL
cmTotUse.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_totuse add column " & !department_name _
& " currency"
cmTotUse.CommandText = strSQL
cmTotUse.Execute
strSQL = "insert into temp_totuse select left(p_id,2) as " & _
"物品類別編號,price as " & !department_name & " from " & _
"sale_detail_b where 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) & ")"
cmTotUse.CommandText = strSQL
cmTotUse.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_totuse add column " & !department_name _
& " currency"
cmTotUse.CommandText = strSQL
cmTotUse.Execute
strSQL = "insert into temp_totuse select left(p_id,2) as " & _
"物品類別編號,price as " & !department_name & " from " & _
"sale_detail_b where sale_id in (select sale_id from " & _
"sale_head_b where sale_rid='" & !department_id _
& "' and year(sale_date)=" & CInt(strY) & ")"
cmTotUse.CommandText = strSQL
cmTotUse.Execute
.MoveNext
Wend
End With
strRptDte = CStr(Format(dteDate, "yyyy年"))
strRptCap = strRptDte & strRptTyp & "年報"
End If
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_totuse2 from temp_totuse group by 物品類別編號"
cmTotUse.CommandText = strSQL
cmTotUse.Execute
strSQL = "delete from temp_totuse"
cmTotUse.CommandText = strSQL
cmTotUse.Execute
strSQL = "insert into temp_totuse select a.物品類別編號,b.type_name as 物品類別名稱"
With rsDepartment
.MoveFirst
While Not .EOF
strSQL = strSQL & ",a." & !department_name & "c as " & _
!department_name
.MoveNext
Wend
End With
strSQL = strSQL & " from temp_totuse2 a,product_type b where " & _
"a.物品類別編號=b.type_id"
cmTotUse.CommandText = strSQL
cmTotUse.Execute
strSQL = "drop table temp_totuse2"
cmTotUse.CommandText = strSQL
cmTotUse.Execute
End Sub
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -