📄 frmxb.frm
字号:
Picture = "frmxb.frx":23E2
Key = ""
EndProperty
BeginProperty ListImage12 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmxb.frx":26FC
Key = ""
EndProperty
BeginProperty ListImage13 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmxb.frx":2A16
Key = ""
EndProperty
BeginProperty ListImage14 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmxb.frx":2D30
Key = ""
EndProperty
BeginProperty ListImage15 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmxb.frx":304A
Key = ""
EndProperty
EndProperty
End
Begin VB.Label Label5
Caption = "输入收支记录的日期后可跳到当天第一个收支情况"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 510
Left = 120
TabIndex = 8
Top = 630
Width = 2820
End
Begin VB.Label Label2
Caption = "收支类别"
BeginProperty Font
Name = "宋体"
Size = 9.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 3450
TabIndex = 7
Top = 2640
Width = 825
End
Begin VB.Label Label1
Appearance = 0 'Flat
BackColor = &H80000004&
Caption = "说明"
BeginProperty Font
Name = "宋体"
Size = 9.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 255
Index = 2
Left = 5715
TabIndex = 6
Top = 1365
Width = 495
End
Begin VB.Label Label1
Caption = "收支金额"
BeginProperty Font
Name = "宋体"
Size = 9.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Index = 1
Left = 3450
TabIndex = 5
Top = 2025
Width = 810
End
Begin VB.Label Label1
Caption = "收支日期"
BeginProperty Font
Name = "宋体"
Size = 9.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Index = 0
Left = 3465
TabIndex = 4
Top = 1440
Width = 810
End
Begin VB.Menu year
Caption = "年度(&Y)"
Begin VB.Menu cl
Caption = "年终处理"
End
End
Begin VB.Menu reco
Caption = "记录(&R)"
Begin VB.Menu zj
Caption = "新增收支"
Shortcut = ^A
End
Begin VB.Menu xg
Caption = "修改收支"
Shortcut = ^E
End
Begin VB.Menu SC
Caption = "删除记录"
Shortcut = ^D
End
Begin VB.Menu sp2
Caption = "-"
End
Begin VB.Menu sy
Caption = "上一记录"
Shortcut = ^P
End
Begin VB.Menu XY
Caption = "下一记录"
Shortcut = ^N
End
Begin VB.Menu SP3
Caption = "-"
End
Begin VB.Menu YJS
Caption = "月结算"
End
Begin VB.Menu PX
Caption = "按时间排序"
End
End
Begin VB.Menu TOOLS
Caption = "工具(&T)"
Begin VB.Menu YD
Caption = "预订..."
End
Begin VB.Menu dc
Caption = "数据导出"
Begin VB.Menu SZ
Caption = "收支详情.."
End
Begin VB.Menu JS
Caption = "每月结算.."
End
End
End
Begin VB.Menu ABOUT
Caption = "关于(&A)"
Begin VB.Menu WRITER
Caption = "关于..."
End
Begin VB.Menu EXIT
Caption = "退出"
End
End
End
Attribute VB_Name = "frmxb"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public myyear As String
Private Sub visok(test As Boolean) '在某些功能启用时，另一些功能不允许用
Dim kk As Integer
If test Then
textfind.Enabled = True
Toolbar1.Buttons.Item(1).Visible = True
zj.Enabled = True
Toolbar1.Buttons.Item(3).Visible = True
sy.Enabled = True
Toolbar1.Buttons.Item(4).Visible = True
XY.Enabled = True
Toolbar1.Buttons.Item(5).Visible = True
xg.Enabled = True
Toolbar1.Buttons.Item(7).Visible = False
Toolbar1.Buttons.Item(8).Visible = False
Slirecon.Enabled = True
For kk = 10 To 16
Toolbar1.Buttons.Item(kk).Visible = True
Next kk
cl.Enabled = True
YJS.Enabled = True
PX.Enabled = True
YD.Enabled = True
SC.Enabled = True
dc.Enabled = True
Text1(0).Locked = True
Text1(1).Locked = True
Text1(2).Locked = True
Combo1.Locked = True
Else
textfind.Enabled = False
Toolbar1.Buttons.Item(1).Visible = False
zj.Enabled = False
Toolbar1.Buttons.Item(3).Visible = False
sy.Enabled = False
Toolbar1.Buttons.Item(4).Visible = False
XY.Enabled = False
Toolbar1.Buttons.Item(5).Visible = False
xg.Enabled = False
Toolbar1.Buttons.Item(7).Visible = True
Toolbar1.Buttons.Item(8).Visible = True
Slirecon.Enabled = False
For kk = 10 To 16
Toolbar1.Buttons.Item(kk).Visible = False
Next kk
cl.Enabled = False
YJS.Enabled = False
PX.Enabled = False
YD.Enabled = False
SC.Enabled = False
dc.Enabled = False
Text1(0).Locked = False
Text1(1).Locked = False
Text1(2).Locked = False
Combo1.Locked = False
End If
End Sub
Private Sub mok() '前进,后退按钮在记录位不同时的不同状态
Dim l As Integer, n As Integer, book As Variant
textfind.Text = Format(Data1.Recordset.Fields(0), "yyyy-mm-dd")
book = Data1.Recordset.Bookmark
Data1.Recordset.MoveFirst
Data1.Recordset.MoveLast
Data1.Recordset.Bookmark = book
n = Data1.Recordset.AbsolutePosition
l = Data1.Recordset.RecordCount - 1
Select Case n
Case 0
Toolbar1.Buttons.Item(3).Enabled = False
sy.Enabled = False
Toolbar1.Buttons.Item(4).Enabled = True
XY.Enabled = True
Case 1 To l - 1
Toolbar1.Buttons.Item(3).Enabled = True
Toolbar1.Buttons.Item(4).Enabled = True
sy.Enabled = True
XY.Enabled = True
Case l
Toolbar1.Buttons.Item(3).Enabled = True
Toolbar1.Buttons.Item(4).Enabled = False
XY.Enabled = False
sy.Enabled = True
End Select
If l = 0 Then
Toolbar1.Buttons.Item(3).Enabled = False
Toolbar1.Buttons.Item(4).Enabled = False
End If
Slirecon.Value = Data1.Recordset.AbsolutePosition
Label10.Caption = Str(Data1.Recordset.AbsolutePosition + 1)
End Sub
Private Sub dctable(tb As String) '导出表为TEXT文件
Dim zb As Database
Dim re As Recordset
Dim refield As Byte
Dim recount As Integer
Dim filenum As Byte
Dim i As Integer
Set zb = OpenDatabase(App.Path + "\zb.mdb")
Set re = zb.OpenRecordset(tb)
refield = re.Fields.Count
re.MoveLast
re.MoveFirst
recount = re.RecordCount
filenum = FreeFile
Open App.Path + "\" + CStr(Date) + ".txt" For Output As filenum
Select Case refield
Case 6
Write #filenum, re.Fields(0).Name, re.Fields(1).Name, re.Fields(2).Name, re.Fields(3).Name, re.Fields(4).Name, re.Fields(5).Name
Case 15
Write #filenum, re.Fields(0).Name, re.Fields(1).Name, re.Fields(2).Name, re.Fields(3).Name, re.Fields(4).Name, _
re.Fields(5).Name, re.Fields(6).Name, re.Fields(7).Name, re.Fields(8).Name, re.Fields(9).Name, _
re.Fields(10).Name, re.Fields(11).Name, re.Fields(12).Name, re.Fields(13).Name, re.Fields(14).Name
End Select
For i = 0 To recount - 1
Select Case refield
Case 6
Write #filenum, CStr(re.Fields(0).Value), re.Fields(1).Value, re.Fields(2).Value, re.Fields(3).Value, CInt(re.Fields(4).Value), re.Fields(5).Value
Case 15
Write #filenum, CStr(re.Fields(0).Value), re.Fields(1).Value, re.Fields(2).Value, re.Fields(3).Value, re.Fields(4).Value, _
re.Fields(5).Value, re.Fields(6).Value, re.Fields(7).Value, re.Fields(8).Value, re.Fields(9).Value, _
re.Fields(10).Value, re.Fields(11).Value, re.Fields(12).Value, re.Fields(13).Value, re.Fields(14).Value
End Select
re.MoveNext
Next i
Close filenum
MsgBox "数据已顺利导出，文件保存为" + App.Path + "\" + CStr(Date) + ".txt。" + Chr(13) + "请及时处理，因为当天若再有数据导出将会被覆盖！", 48, "提示"
End Sub
Private Sub cl_Click()
If Not (Month(Date) = 12 And Day(Date) = 31) Then
Dim n As Integer
n = MsgBox("未到12月31日,如提前作年终处理,则使统计数据不准和这以后的数据当年度查不到!(除非在元旦前不输数据)" + Chr(13) + "你的确要作此处理吗?", 36, "年终处理")
If n = 7 Then Exit Sub
End If
Comzt_Click '整年处理
Dim i As Integer, j As Integer, SZ As Single
Dim zb As Database
Dim reyear As Recordset
Dim reyzj As Recordset
Set zb = OpenDatabase(App.Path + "\zb.mdb")
Set reyear = zb.OpenRecordset("year", dbOpenDynaset) 'dbOpenDynaset类型才能用find
reyear.FindFirst ("年度='" + myyear + "'") '在YEAR表中找当前年度的处理情况
If reyear.NoMatch = True Then '若没有当前年度的记录则加入
reyear.AddNew
reyear.Fields(0) = myyear
reyear.Update
reyear.FindFirst ("年度='" + myyear + "'")
End If
Data2.Recordset.MoveLast
Data2.Recordset.MoveFirst 'YZJ表移到头
reyear.Edit
If reyear.AbsolutePosition = 0 Then '如果是年度中的第一个记录
reyear.Fields(1) = Data2.Recordset.Fields(1) '则用月表中的第一条记录的上月结余
Else '若是其它年度记录则用上年度的结余
reyear.MovePrevious
SZ = reyear.Fields(4)
reyear.MoveNext
reyear.Edit
reyear.Fields(1) = SZ
End If
For i = 5 To reyear.Fields.Count - 1
SZ = 0
For j = 1 To Data2.Recordset.RecordCount
SZ = Data2.Recordset.Fields(i) + SZ '循环计算YZJ表中各项收支数值和并存入YEAR表中
Data2.Recordset.MoveNext
Next j
reyear.Fields(i) = SZ
Data2.Recordset.MoveFirst
Next i
Data2.Recordset.MoveLast
reyear.Fields(2) = 0
reyear.Fields(3) = 0
For i = 1 To 5
reyear.Fields(2) = reyear.Fields(i + 4) + reyear.Fields(2) '当年的收入
reyear.Fields(3) = reyear.Fields(i + 9) + reyear.Fields(3) '当年的支出
Next i
reyear.Fields(4) = reyear.Fields(1) + reyear.Fields(2) - reyear.Fields(3) '得到当年结余
SZ = reyear.Fields(4)
reyear.Update
reyear.FindFirst ("年度 ='" + Trim(Str(Val(myyear) + 1)) + "'") '当年处理完后,找下一年度的记录
If reyear.NoMatch = True Then
reyear.AddNew '没有则加入
Else
reyear.Edit
End If
reyear.Fields(0) = Trim(Str(Val(myyear) + 1)) '并且对year表中下一年度初始化
reyear.Fields(1) = SZ
reyear.Update
Set reyzj = zb.OpenRecordset("yzj", dbOpenDynaset) '打开含有每年收支数据的YZJ表(dbOpenDynaset类型才能用find)
reyzj.FindFirst ("year(年月)='" + Trim(Str(Val(myyear) + 1)) + "'") '查找下一年度的第一条记录
If reyzj.NoMatch = True Then
reyzj.AddNew '没找到则加入
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -