📄 frmlr.frm
字号:
VERSION 5.00
Begin VB.Form Frmlr
BorderStyle = 1 'Fixed Single
Caption = "个人财务管理系统-收支浏览"
ClientHeight = 6015
ClientLeft = 45
ClientTop = 330
ClientWidth = 7365
Icon = "Frmlr.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 6015
ScaleWidth = 7365
StartUpPosition = 2 '屏幕中心
Begin VB.CommandButton Comzc
Caption = "全选支出"
Height = 300
Left = 5670
TabIndex = 26
Top = 4470
Width = 1530
End
Begin VB.CommandButton Comsl
Caption = "全选收入"
Height = 300
Left = 5670
TabIndex = 25
Top = 4095
Width = 1530
End
Begin VB.CommandButton Command1
Caption = "刷新列表"
Height = 360
Left = 750
TabIndex = 24
Top = 5385
Width = 1470
End
Begin VB.CheckBox Check1
Caption = "其它支出"
Height = 270
Index = 9
Left = 4515
TabIndex = 23
Top = 4485
Width = 1050
End
Begin VB.CheckBox Check1
Caption = "投资支出"
Height = 270
Index = 8
Left = 3435
TabIndex = 22
Top = 4470
Width = 1050
End
Begin VB.CheckBox Check1
Caption = "学习支出"
Height = 270
Index = 7
Left = 2325
TabIndex = 21
Top = 4485
Width = 1050
End
Begin VB.CheckBox Check1
Caption = "娱乐支出"
Height = 270
Index = 6
Left = 1230
TabIndex = 20
Top = 4470
Width = 1050
End
Begin VB.CheckBox Check1
Caption = "生活支出"
Height = 270
Index = 5
Left = 120
TabIndex = 19
Top = 4470
Width = 1050
End
Begin VB.CheckBox Check1
Caption = "其它收入"
Height = 270
Index = 4
Left = 4500
TabIndex = 18
Top = 4140
Width = 1050
End
Begin VB.CheckBox Check1
Caption = "打工收入"
Height = 270
Index = 3
Left = 3420
TabIndex = 17
Top = 4140
Width = 1050
End
Begin VB.CheckBox Check1
Caption = "福利收入"
Height = 270
Index = 2
Left = 2325
TabIndex = 16
Top = 4140
Width = 1050
End
Begin VB.CheckBox Check1
Caption = "奖金收入"
Height = 270
Index = 1
Left = 1215
TabIndex = 15
Top = 4125
Width = 1050
End
Begin VB.CheckBox Check1
Caption = "工资收入"
Height = 270
Index = 0
Left = 120
TabIndex = 14
Top = 4125
Width = 1050
End
Begin VB.CommandButton Comexit
Caption = "返回"
Height = 390
Left = 4755
TabIndex = 13
Top = 5340
Width = 1470
End
Begin VB.TextBox Textzf
Height = 285
Left = 5685
Locked = -1 'True
TabIndex = 10
Top = 4950
Width = 1500
End
Begin VB.TextBox Textsl
Height = 285
Left = 1980
Locked = -1 'True
TabIndex = 9
Top = 4950
Width = 1500
End
Begin VB.TextBox Textmaxmon
Height = 270
Left = 6255
TabIndex = 8
Text = "Text4"
Top = 3690
Width = 1050
End
Begin VB.TextBox Textminmon
Height = 270
Left = 5040
TabIndex = 7
Text = "Text3"
Top = 3690
Width = 1005
End
Begin VB.TextBox Textmaxdate
Height = 270
Left = 2760
TabIndex = 6
Text = "Text2"
Top = 3690
Width = 1230
End
Begin VB.TextBox Textmindate
Height = 270
Left = 1305
TabIndex = 5
Text = "Text1"
Top = 3690
Width = 1140
End
Begin VB.Data Data1
Caption = "Data1"
Connect = "Access"
DatabaseName = ""
DefaultCursorType= 0 '缺省游标
DefaultType = 2 '使用 ODBC
Exclusive = 0 'False
Height = 345
Left = 4995
Options = 0
ReadOnly = 0 'False
RecordsetType = 1 'Dynaset
RecordSource = "xb"
Top = 5325
Visible = 0 'False
Width = 1410
End
Begin VB.PictureBox DBGridlr
Height = 3570
Left = 0
ScaleHeight = 3510
ScaleWidth = 7305
TabIndex = 0
Top = 0
Width = 7365
End
Begin VB.Label Label6
Caption = "所显示记录的支付总额"
Height = 195
Left = 3780
TabIndex = 12
Top = 4995
Width = 1905
End
Begin VB.Label Label5
Caption = "所显示记录的收入总额"
Height = 240
Left = 90
TabIndex = 11
Top = 4995
Width = 1905
End
Begin VB.Label Label4
Caption = "至"
Height = 195
Left = 6075
TabIndex = 4
Top = 3735
Width = 150
End
Begin VB.Label Label3
Caption = "收支金额从"
Height = 195
Left = 4140
TabIndex = 3
Top = 3735
Width = 960
End
Begin VB.Label Label2
Caption = "到"
Height = 195
Left = 2475
TabIndex = 2
Top = 3735
Width = 195
End
Begin VB.Label Label1
Caption = "浏览收支日期从从"
Height = 195
Left = 45
TabIndex = 1
Top = 3735
Width = 1275
End
End
Attribute VB_Name = "Frmlr"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private dbzb As Database, relr As Recordset
Private Sub Comexit_Click()
Unload Me
'frmxb.Show
End Sub
Private Sub Command1_Click()
Dim i As Integer, lb(10) As String
Dim t As Integer, sd As String
If CDate(Textmaxdate.Text) < CDate(Textmindate.Text) Then
MsgBox "后面的日期应大于前面的!" + Chr(13) + "为了选出您想要的记录请修改过来.", 48, "日期错误"
Textmaxdate.SelStart = 0
Textmaxdate.SelLength = 8
Textmaxdate.SetFocus
Exit Sub
End If
If Val(Textmaxmon.Text) < Val(Textminmon.Text) Then
MsgBox "后面的金额应大于前面的!" + Chr(13) + "为了选出您想要的记录请修改过来.", 48, "金额错误"
Textmaxmon.SelStart = 0
Textmaxmon.SelLength = 10
Textmaxmon.SetFocus
Exit Sub
End If
t = 0
For i = 1 To 10
lb(i) = Check1(i - 1).Caption
Next i
sd = ""
For i = 1 To 10
If Check1(i - 1).Value = 1 Then
If Len(sd) <> 0 Then
sd = sd + "'or 类别='" + lb(i)
Else
sd = lb(i)
End If
End If
Next i
sd = "( 类别='" + sd + "')"
Data1.RecordSource = "select * from xb where " + sd + " and [收支日期]>=cdate(" + "'" + Trim(Textmindate.Text) + "'" + ") and [收支日期]<=cdate(" + "'" + Trim(Textmaxdate.Text) + "'" + ")and [收支金额]>=" + Textminmon.Text + " and [收支金额]<=" + Textmaxmon.Text + " ORDER BY [收支日期] ASC"
'虽然TEXT是字符但仍要在括号中加单引号才能正确计算
Data1.Refresh
Set relr = dbzb.OpenRecordset("select sum(收支金额) from xb where mid(类别,3,2)='收入' and " + sd + " and [收支日期]>=cdate(" + "'" + Trim(Textmindate.Text) + "'" + ") and [收支日期]<=cdate(" + "'" + Trim(Textmaxdate.Text) + "'" + ")and [收支金额]>=" + Textminmon.Text + " and [收支金额]<=" + Textmaxmon.Text)
Textsl.Text = Format(relr.Fields(0), "currency")
Set relr = dbzb.OpenRecordset("select sum(收支金额) from xb where mid(类别,3,2)='支出' and " + sd + " and [收支日期]>=cdate(" + "'" + Trim(Textmindate.Text) + "'" + ") and [收支日期]<=cdate(" + "'" + Trim(Textmaxdate.Text) + "'" + ")and [收支金额]>=" + Textminmon.Text + " and [收支金额]<=" + Textmaxmon.Text)
Textzf.Text = Format(relr.Fields(0), "currency")
End Sub
Private Sub Comsl_Click()
Static t As Byte
Dim i As Integer
If t = 0 Then
t = 1
For i = 0 To 4
Check1(i).Value = 1
Next i
Comsl.Caption = "不选收入"
Else
t = 0
For i = 0 To 4
Check1(i).Value = 0
Next i
Comsl.Caption = "全选收入"
End If
End Sub
Private Sub Comzc_Click()
Static t As Byte
Dim i As Integer
If t = 0 Then
t = 1
For i = 5 To 9
Check1(i).Value = 1
Next i
Comzc.Caption = "不选支出"
Else
t = 0
For i = 5 To 9
Check1(i).Value = 0
Next i
Comzc.Caption = "全选支出"
End If
End Sub
Private Sub Form_Activate()
Me.Caption = "家庭收支薄-收支浏览" + "(" + frmxb.myyear + "年度)"
Data1.DatabaseName = App.Path + "\zb.mdb"
Data1.RecordSource = ("select * from xb where year(收支日期)='" + frmxb.myyear + "'")
Set dbzb = OpenDatabase(App.Path + "\zb.mdb")
Set relr = dbzb.OpenRecordset("select min(收支日期),max(收支日期),min(收支金额),max(收支金额) from xb where year(收支日期)='" + frmxb.myyear + "'")
Textmindate.Text = relr.Fields(0)
Textmaxdate.Text = relr.Fields(1)
Textminmon.Text = relr.Fields(2)
Textmaxmon.Text = relr.Fields(3)
'Set relr = dbzb.OpenRecordset("select sum(收支金额) from xb where (收支标志=true and year(收支日期)='" + frmxb.myyear + "')")
'Textsl.Text = Format(relr.Fields(0), "currency")
'Set relr = dbzb.OpenRecordset("select sum(收支金额) from xb where (收支标志=false and year(收支日期)='" + frmxb.myyear + "')")
'Textzf.Text = Format(relr.Fields(0), "currency")
End Sub
Private Sub Textmindate_LostFocus()
If Not IsDate(Textmindate.Text) Then
Textmindate.SelStart = 0
Textmindate.SelLength = 8
Textmindate.SetFocus
End If
End Sub
Private Sub Textmaxdate_LostFocus()
If Not IsDate(Textmaxdate.Text) Then
Textmaxdate.SelStart = 0
Textmaxdate.SelLength = 8
Textmaxdate.SetFocus
' Exit Sub
End If
End Sub
Private Sub Textminmon_LostFocus()
If Not IsNumeric(Textminmon.Text) Then
Textminmon.SetFocus
Textminmon.SelStart = 0
Textminmon.SelLength = Len(Textminmon.Text)
End If
End Sub
Private Sub Textmaxmon_LostFocus()
If Not IsNumeric(Textmaxmon.Text) Then
Textmaxmon.SetFocus
Textmaxmon.SelStart = 0
Textmaxmon.SelLength = Len(Textmaxmon.Text)
'Exit Sub
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -