📄 frmreport.frm
字号:
VERSION 5.00
Begin VB.Form frmreport
BorderStyle = 1 'Fixed Single
Caption = "报表"
ClientHeight = 3030
ClientLeft = 45
ClientTop = 330
ClientWidth = 4305
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3030
ScaleWidth = 4305
StartUpPosition = 2 '屏幕中心
Begin VB.ComboBox dbcbo_kind
Height = 300
ItemData = "frmreport.frx":0000
Left = 1680
List = "frmreport.frx":0002
TabIndex = 6
Top = 1560
Width = 1695
End
Begin VB.CommandButton cmdexit
Caption = "退出"
Height = 495
Left = 3000
TabIndex = 5
Top = 2400
Width = 1095
End
Begin VB.CommandButton cmdprint
Caption = "打印"
Height = 495
Left = 1500
TabIndex = 4
Top = 2400
Width = 1095
End
Begin VB.CommandButton cmdpreview
Caption = "预览"
Height = 495
Left = 120
Style = 1 'Graphical
TabIndex = 3
Top = 2400
Width = 1215
End
Begin VB.Frame Frame1
Caption = "选择报表类型"
Height = 2175
Left = 0
TabIndex = 0
Top = 0
Width = 4215
Begin VB.OptionButton optall
Caption = "所有开支报表"
Height = 180
Left = 240
TabIndex = 13
Top = 240
Width = 1455
End
Begin VB.OptionButton optmonth
Caption = "开支月报表"
Height = 255
Left = 240
TabIndex = 12
Top = 840
Width = 1215
End
Begin VB.OptionButton optkind
Caption = "分类开支报表"
Height = 180
Left = 240
TabIndex = 11
Top = 1680
Width = 1455
End
Begin VB.ComboBox cboday
Height = 300
ItemData = "frmreport.frx":0004
Left = 3480
List = "frmreport.frx":0011
Locked = -1 'True
TabIndex = 7
Text = "30"
Top = 840
Visible = 0 'False
Width = 615
End
Begin VB.ComboBox cbomonth
Height = 300
ItemData = "frmreport.frx":0021
Left = 2760
List = "frmreport.frx":0049
Style = 2 'Dropdown List
TabIndex = 2
Top = 840
Width = 615
End
Begin VB.TextBox txtyear
Height = 270
Left = 1680
TabIndex = 1
Top = 840
Width = 975
End
Begin VB.Label Label3
Caption = "该月天数"
Height = 255
Left = 3480
TabIndex = 10
Top = 600
Visible = 0 'False
Width = 735
End
Begin VB.Label Label2
Caption = "月"
Height = 255
Left = 3000
TabIndex = 9
Top = 600
Width = 255
End
Begin VB.Label Label1
Caption = "年"
Height = 255
Left = 2040
TabIndex = 8
Top = 600
Width = 255
End
End
End
Attribute VB_Name = "frmreport"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public Sub rptmonth()
Dim db As Database
Dim rst As Recordset
Dim rst1 As Recordset
Dim sql As String
Set db = OpenDatabase(App.Path & "\payout.mdb")
Set rst1 = db.OpenRecordset("select * from payout_report")
On Error GoTo kk:
If rst1.RecordCount > 0 Then
rst1.MoveFirst
Do Until rst1.EOF
rst1.Delete
rst1.MoveNext
Loop
End If
kk:
If txtyear.Text = "" Or cbomonth.Text = "" Then
MsgBox "请输入开支的年份和选择月份!", vbOKOnly + vbInformation, "提示"
Exit Sub
Else
'sql = "select * from payout where " & "pay_date <= " & "#" & Year(Date$) & "-" & Month(Date$) & "-" & "31" & " # " & " And " & "pay_date >= " & "#" & Year(Date$) & "-" & Month(Date$) & "-" & "01" & " #"
sql = "select * from payout where " & "pay_date <= " & "#" & Trim$(txtyear.Text) & "-" & Trim$(cbomonth.Text) & "-" & Trim$(cboday.Text) & " # " & " And " & "pay_date >= " & "#" & Trim$(txtyear.Text) & "-" & Trim$(cbomonth.Text) & "-" & "01" & "#"
Set rst = db.OpenRecordset(sql)
If rst.RecordCount = 0 Then
MsgBox "没有生成记录,重新设置条件或者数据库中没有记录,请在程序其它查看!", vbOKOnly + vbExclamation, "警告"
Exit Sub
End If
rst.MoveFirst
Do Until rst.EOF
With rst1
.addnew
!pay_order = rst.Fields("pay_order")
!pay_date = rst.Fields("pay_date")
!pay_usename = rst.Fields("pay_usename")
!pay_kind = rst.Fields("pay_kind")
!pay_money = rst.Fields("pay_money")
.Update
rst.MoveNext
End With
Loop
report.Show
End If
rst.Close
'rst1.Close
End Sub
Public Sub prtmonth()
Dim db As Database
Dim rst As Recordset
Dim rst1 As Recordset
Dim sql As String
Set db = OpenDatabase(App.Path & "\payout.mdb")
Set rst1 = db.OpenRecordset("select * from payout_report")
On Error GoTo kk:
If rst1.RecordCount > 0 Then
rst1.MoveFirst
Do Until rst1.EOF
rst1.Delete
rst1.MoveNext
Loop
End If
kk:
If txtyear.Text = "" Or cbomonth.Text = "" Then
MsgBox "请输入开支的年份和选择月份!", vbOKOnly + vbInformation, "提示"
Exit Sub
Else
'sql = "select * from payout where " & "pay_date <= " & "#" & Year(Date$) & "-" & Month(Date$) & "-" & "31" & " # " & " And " & "pay_date >= " & "#" & Year(Date$) & "-" & Month(Date$) & "-" & "01" & " #"
sql = "select * from payout where " & "pay_date <= " & "#" & Trim$(txtyear.Text) & "-" & Trim$(cbomonth.Text) & "-" & Trim$(cboday.Text) & " # " & " And " & "pay_date >= " & "#" & Trim$(txtyear.Text) & "-" & Trim$(cbomonth.Text) & "-" & "01" & "#"
Set rst = db.OpenRecordset(sql)
If rst.RecordCount = 0 Then
MsgBox "没有生成记录,重新设置条件或者数据库中没有记录,请在程序其它查看!", vbOKOnly + vbExclamation, "警告"
Exit Sub
End If
rst.MoveFirst
Do Until rst.EOF
With rst1
.addnew
!pay_order = rst.Fields("pay_order")
!pay_date = rst.Fields("pay_date")
!pay_usename = rst.Fields("pay_usename")
!pay_kind = rst.Fields("pay_kind")
!pay_money = rst.Fields("pay_money")
.Update
rst.MoveNext
End With
Loop
'report.Show
End If
rst.Close
rst1.Close
End Sub
Public Sub rptkind()
Dim db As Database
Dim rst As Recordset
Dim rst1 As Recordset
Dim sql As String
Set db = OpenDatabase(App.Path & "\payout.mdb")
'sql = ("select * from payout where pay_kind ='" & Trim$(dbcbo_kind.Text) & "'")
Set rst1 = db.OpenRecordset("select * from payout_report")
On Error GoTo kk:
' If rst1.RecordCount > 0 Then
rst1.MoveFirst
Do Until rst1.EOF
rst1.Delete
rst1.MoveFirst
Loop
' End If
kk:
If dbcbo_kind.Text = "" Then
MsgBox "请选择种类!", vbOKOnly + vbInformation, "提示"
Exit Sub
End If
sql = "select * from payout where pay_kind='" & dbcbo_kind.Text & "'"
Set rst = db.OpenRecordset(sql)
If rst.RecordCount = 0 Then
MsgBox "没有生成记录,重新设置条件或者数据库中没有记录,请在程序其它查看!", vbOKOnly + vbExclamation, "警告"
Exit Sub
End If
rst.MoveFirst
Do Until rst.EOF
With rst1
.addnew
!pay_order = rst.Fields("pay_order")
!pay_date = rst.Fields("pay_date")
!pay_usename = rst.Fields("pay_usename")
!pay_kind = rst.Fields("pay_kind")
!pay_money = rst.Fields("pay_money")
.Update
rst.MoveNext
End With
Loop
report.Show
rst.Close
'rst1.Close
End Sub
Public Sub prtkind()
Dim db As Database
Dim rst As Recordset
Dim rst1 As Recordset
Dim sql As String
Set db = OpenDatabase(App.Path & "\payout.mdb")
sql = ("select * from payout where pay_kind ='" & Trim$(dbcbo_kind.Text) & "'")
Set rst1 = db.OpenRecordset("select * from payout_report")
On Error GoTo kk:
' If rst1.RecordCount > 0 Then
rst1.MoveFirst
Do Until rst1.EOF
rst1.Delete
rst1.MoveFirst
Loop
' End If
kk:
If dbcbo_kind.Text = "" Then
MsgBox "请选择种类!", vbOKOnly + vbInformation, "提示"
Exit Sub
End If
sql = "select * from payout where pay_kind='" & dbcbo_kind.Text & "'"
Set rst = db.OpenRecordset(sql)
If rst.RecordCount = 0 Then
MsgBox "没有生成记录,重新设置条件或者数据库中没有记录,请在程序其它查看!", vbOKOnly + vbExclamation, "警告"
Exit Sub
End If
rst.MoveFirst
Do Until rst.EOF
With rst1
.addnew
!pay_order = rst.Fields("pay_order")
!pay_date = rst.Fields("pay_date")
!pay_usename = rst.Fields("pay_usename")
!pay_kind = rst.Fields("pay_kind")
!pay_money = rst.Fields("pay_money")
.Update
rst.MoveNext
End With
Loop
'report.Show
rst.Close
rst1.Close
End Sub
Private Sub cbomonth_Click()
If Trim$(txtyear.Text) = "" Then
MsgBox "年份不能为空!", vbOKOnly + vbExclamation, "年份为空!"
'ElseIf Trim$(txtyear.Text) < 1904 And Trim$(txtyear.Text) > 2079 Then
' MsgBox "年份一定要为数字!且不能小于1904和大于2079", vbOKOnly + vbExclamation, "年份错!"
End If
If (Trim$(txtyear.Text) Mod 4) = 0 And Trim$(cbomonth.Text) = 2 Then
cboday.Text = 29
ElseIf Trim$(cbomonth.Text) = 2 Then
cboday.Text = 28
ElseIf (Trim$(cbomonth.Text) = 1 Or Trim$(cbomonth.Text) = 3 Or Trim$(cbomonth.Text) = 5 Or Trim$(cbomonth.Text) = 7 Or Trim$(cbomonth.Text) = 8 Or Trim$(cbomonth.Text) = 10 Or Trim$(cbomonth.Text) = 12) Then
cboday.Text = 31
Else
cboday.Text = 30
End If
End Sub
Private Sub cmdexit_Click()
Unload Me
frmmain.Show
End Sub
Private Sub cmdpreview_Click()
If optall.Value = True Then
Reportall.Show
ElseIf optmonth.Value = True And txtyear.Text <> "" And cbomonth.Text <> "" Then
lblcaption = optmonth.Caption
Call rptmonth
ElseIf optkind.Value = True And dbcbo_kind.Text <> "" Then
lblcaption = optkind.Caption
Call rptkind
Else
MsgBox "请选择条件", vbOKOnly + vbExclamation, "警告"
End If
End Sub
Private Sub cmdprint_Click()
If optall.Value = True Then
cookie = Reportall.PrintReport(True, rptRangeAllPages)
Else
If optmonth.Value = True Then
lblcaption = optmonth.Caption
Call prtmonth
cookie = report.PrintReport(True, rptRangeAllPages)
ElseIf optkind.Value = True Then
lblcaption = optkind.Caption
Call prtkind
cookie = report.PrintReport(True, rptRangeAllPages)
End If
End If
End Sub
Private Sub Form_Activate()
Dim db As Database
Dim dkrs As Recordset
Set db = OpenDatabase(App.Path & "\payout.mdb")
Set dkrs = db.OpenRecordset("dkind")
If Not dkrs.EOF Then
dkrs.MoveFirst
Do Until dkrs.EOF
dbcbo_kind.AddItem Trim$(dkrs!dkind_name)
dkrs.MoveNext
Loop
Else
MsgBox "数据库中没有大类别数据,请在添加!", vbOKOnly + vbInformation, "设置大类别"
End If
dkrs.Close
End Sub
Private Sub Form_Load()
txtyear.Text = Year(Date$)
txtyear.Locked = True
cbomonth.Locked = True
dbcbo_kind.Locked = True
End Sub
Private Sub optkind_Click()
'使别的查询框无效,使与该单选框对应的文本框有效
If optkind.Value = True Then
dbcbo_kind.Locked = False
txtyear.Locked = True
cbomonth.Locked = True
End If
End Sub
Private Sub optmonth_Click()
If optmonth.Value = True Then
txtyear.Locked = False
cbomonth.Locked = False
dbcbo_kind.Locked = True
End If
End Sub
Private Sub txtyear_KeyPress(KeyAscii As Integer)
If KeyAscii < Asc("0") Or KeyAscii > Asc("9") Then
KeyAscii = 0
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -