?? frm_expend.frm
字號:
VERSION 5.00
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Object = "{0ECD9B60-23AA-11D0-B351-00A0C9055D8E}#6.0#0"; "MSHFLXGD.OCX"
Begin VB.Form frm_expend
BackColor = &H00FFFFC0&
Caption = "日常支出"
ClientHeight = 7350
ClientLeft = 60
ClientTop = 345
ClientWidth = 9375
Icon = "frm_expend.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
ScaleHeight = 7350
ScaleWidth = 9375
StartUpPosition = 2 '屏幕中心
Begin VB.CommandButton cmd_close
Caption = "關閉"
Height = 375
Left = 5280
TabIndex = 11
Top = 6600
Width = 735
End
Begin VB.CommandButton cmd_del
Caption = "刪除"
Height = 375
Left = 4560
TabIndex = 10
Top = 6600
Width = 735
End
Begin VB.CommandButton cmd_edit
Caption = "修改"
Height = 375
Left = 3840
TabIndex = 9
Top = 6600
Width = 735
End
Begin VB.CommandButton cmd_add
Caption = "添加"
Height = 375
Left = 3120
TabIndex = 8
Top = 6600
Width = 735
End
Begin MSHierarchicalFlexGridLib.MSHFlexGrid MSHFlexGrid1
Height = 3975
Left = 0
TabIndex = 20
Top = 0
Width = 9375
_ExtentX = 16536
_ExtentY = 7011
_Version = 393216
AllowUserResizing= 1
_NumberOfBands = 1
_Band(0).Cols = 2
End
Begin VB.Frame Frame1
BackColor = &H00FFFFC0&
Height = 2295
Left = 0
TabIndex = 0
Top = 3960
Width = 9375
Begin VB.TextBox txt_note
Height = 270
Left = 7080
TabIndex = 21
Text = "Text1"
Top = 960
Visible = 0 'False
Width = 735
End
Begin VB.TextBox txt_mome
Alignment = 2 'Center
Height = 660
Left = 3600
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 7
Top = 1440
Width = 3015
End
Begin VB.TextBox txt_intake
Height = 300
Left = 3600
TabIndex = 5
Top = 840
Width = 3015
End
Begin VB.ComboBox Combo3
Height = 300
Left = 840
TabIndex = 6
Top = 1440
Width = 1815
End
Begin VB.ComboBox Combo2
Height = 300
Left = 840
TabIndex = 4
Top = 840
Width = 1815
End
Begin VB.TextBox txt_money
Height = 300
Left = 7080
TabIndex = 3
Top = 240
Width = 1215
End
Begin VB.ComboBox Combo1
Height = 300
ItemData = "frm_expend.frx":030A
Left = 3600
List = "frm_expend.frx":0311
TabIndex = 2
Top = 240
Width = 1695
End
Begin MSComCtl2.DTPicker DTPicker1
Height = 300
Left = 840
TabIndex = 1
Top = 240
Width = 1815
_ExtentX = 3201
_ExtentY = 529
_Version = 393216
Format = 24772609
CurrentDate = 37817
End
Begin VB.Label Label8
BackStyle = 0 'Transparent
Caption = "元"
Height = 255
Left = 8520
TabIndex = 19
Top = 240
Width = 375
End
Begin VB.Label Label7
BackStyle = 0 'Transparent
Caption = "備注："
Height = 375
Left = 3000
TabIndex = 18
Top = 1440
Width = 615
End
Begin VB.Label Label6
BackStyle = 0 'Transparent
Caption = "人員："
Height = 375
Left = 240
TabIndex = 17
Top = 1440
Width = 615
End
Begin VB.Label Label5
BackStyle = 0 'Transparent
Caption = "去向："
Height = 255
Left = 3000
TabIndex = 16
Top = 840
Width = 615
End
Begin VB.Label Label4
BackStyle = 0 'Transparent
Caption = "項目："
Height = 375
Left = 240
TabIndex = 15
Top = 840
Width = 615
End
Begin VB.Label Label3
BackStyle = 0 'Transparent
Caption = "金額："
Height = 375
Left = 6480
TabIndex = 14
Top = 240
Width = 615
End
Begin VB.Label Label2
BackStyle = 0 'Transparent
Caption = "方式："
Height = 255
Left = 3000
TabIndex = 13
Top = 240
Width = 615
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "日期："
Height = 375
Left = 240
TabIndex = 12
Top = 240
Width = 615
End
End
End
Attribute VB_Name = "frm_expend"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim Mydb As New ADODB.Recordset
Dim Mydb1 As New ADODB.Recordset
Dim Mydb2 As New ADODB.Recordset
Dim Count1 As New ADODB.Recordset
Dim Str_text As String
Private Sub cmd_add_Click()
On Error Resume Next
Dim A, B
B = 1
Set Count1 = ExeCutesql("select * from 支出", Str_text)
Count1.MoveLast
B = Count1.Fields(7) + 1
A = MsgBox("是否添加前記錄？", vbYesNo + 32, "添加記錄")
If A = vbYes Then
If txt_intake.Text = "" Then
MsgBox "請填寫去向！", vbOKOnly + 32, "注意！"
Else
ExeCutesql "insert into 支出 values('" & Format(DTPicker1.Value, "yyyy-mm-dd") & "','" _
& Combo1.Text & "','" & txt_money.Text & "','" & Combo2.Text & "','" & txt_intake.Text _
& "','" & Combo3.Text & "','" & txt_mome.Text & "','" & B & "')", Str_text
MsgBox "數據已經保存！", vbOKOnly + 64, "成功"
Call Xiangmu
Call Db
End If
End If
End Sub
Private Sub cmd_close_Click()
Unload Me
End Sub
Private Sub cmd_del_Click()
On Error Resume Next
Dim A
A = MsgBox("是否刪除當前記錄？", vbYesNo + 32 + 256, "添加記錄")
If A = vbYes Then
ExeCutesql "DELETE from 支出 where key=" & txt_note.Text & "", Str_text
Call Db
Set Mydb = ExeCutesql("select * from 支出 ", Str_text)
Set MSHFlexGrid1.DataSource = Mydb
End If
End Sub
Private Sub cmd_edit_Click()
On Error Resume Next
Dim A
A = MsgBox("是否修改前記錄？", vbYesNo + 32, "添加記錄")
If A = vbYes Then
ExeCutesql "Update 支出 Set 日期 = '" & Format(DTPicker1.Value, "yyyy-mm-dd") & "',方式='" & Combo1.Text & "',金額=" & txt_money.Text & ", 去向='" & txt_intake.Text & "',人員='" & Combo3.Text & "',備注='" & txt_mome.Text & "' Where key = " & txt_note.Text & " ", Str_text
'Mydb.Requery
Call Db
MsgBox "數據修改成功！", vbOKOnly + 64, "成功"
End If
End Sub
Private Sub Combo2_Change()
Call Db1
End Sub
Private Sub Combo3_Change()
Call Db2
End Sub
Private Sub Form_Load()
Call Db
Call Db1
Call Db2
DTPicker1.Value = Date
' Combo3.Locked = True
' Combo1.Locked = True
End Sub
Public Function Db()
Set Mydb = ExeCutesql("select * from 支出 order by key", Str_text)
Set MSHFlexGrid1.DataSource = Mydb
End Function
Public Function Db1()
On Error Resume Next
Dim A As Integer
Set Mydb1 = ExeCutesql("select * from 支出項目 ", Str_text)
A = Mydb1.RecordCount
Set Combo2.DataSource = Mydb1
For I = 1 To A
Combo2.AddItem Mydb1.Fields(0)
Mydb1.MoveNext
If Mydb1.EOF Then Exit For
Next I
End Function
Public Function Db2()
On Error Resume Next
Dim A As Integer
Set Mydb2 = ExeCutesql("select * from 成員", Str_text)
A = Mydb2.RecordCount
Set Combo3.DataSource = Mydb2
For I = 1 To A
Combo3.AddItem Mydb2.Fields(0)
Mydb2.MoveNext
If Mydb2.EOF Then Exit For
Next I
Combo3.AddItem "全家"
End Function
Private Sub Form_Unload(Cancel As Integer)
'Mydb.Close
'Mydb1.Close
'Mydb2.Close
End Sub
Private Sub MSHFlexGrid1_Click()
On Error Resume Next
DTPicker1.Value = MSHFlexGrid1.TextMatrix(MSHFlexGrid1.Row, 1)
Combo1.Text = MSHFlexGrid1.TextMatrix(MSHFlexGrid1.Row, 2)
txt_money.Text = MSHFlexGrid1.TextMatrix(MSHFlexGrid1.Row, 3)
Combo2.Text = MSHFlexGrid1.TextMatrix(MSHFlexGrid1.Row, 4)
txt_intake.Text = MSHFlexGrid1.TextMatrix(MSHFlexGrid1.Row, 5)
Combo3.Text = MSHFlexGrid1.TextMatrix(MSHFlexGrid1.Row, 6)
txt_mome.Text = MSHFlexGrid1.TextMatrix(MSHFlexGrid1.Row, 7)
txt_note.Text = MSHFlexGrid1.TextMatrix(MSHFlexGrid1.Row, 8)
End Sub
Private Sub txt_money_LostFocus()
Dim A As Boolean
Dim C
C = txt_money.Text
A = IsNumeric(C)
If C = "" Then
MsgBox "請輸入金額！", vbOKOnly + 32, "注意！"
txt_money.SetFocus
Else
If A = False Then
MsgBox "金額只能輸入數字！", vbOKOnly + 32, "注意！"
txt_money.SetFocus
End If
End If
End Sub
Private Function Xiangmu()
Dim A
Dim Str_text As String
Dim Db As New ADODB.Recordset
Str_text = Combo2.Text
Set Db = ExeCutesql("select * from 支出項目 where value='" & Str_text & "'", "")
'MsgBox
If Not Str_text = Db.Fields(0) Then
ExeCutesql "insert into 支出項目 values('" & Str_text & "')", ""
End If
End Function
Private Function Renyuan()
'Dim A
'Dim Str_text As String
'Dim Db As New ADODB.Recordset
'Str_text = Combo3.Text
'Set Db = ExeCutesql("select * from 成員 where value='" & Str_text & "'", "")
'MsgBox
'If Not Str_text = Db.Fields(0) Then
' ExeCutesql "insert into 成員 values('" & Str_text & "')", ""
'End If
End Function
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -