frmqu_de.frm

对家庭的开支有一个全面的了解和统计

End Sub
Public Sub viewdata()

txt_order = rs.Fields("pay_order")
DTPicker_date = rs.Fields("pay_date")
cbo_usename = rs.Fields("pay_usename")
cbo_kind = rs.Fields("pay_kind")
cbo_xkind = rs.Fields("payx_kind")
txt_money = rs.Fields("pay_money")
End Sub

Private Sub cmdfirst_Click()
On Error Resume Next
rs.MoveFirst
Call viewdata
End Sub

Private Sub cmdlast_Click()
On Error Resume Next
rs.MoveLast

Call viewdata
End Sub

Private Sub cmdmodify_Click()

txtchange = Trim$(txt_order.Text)

'使各按钮无效
cmdfirst.Enabled = False
cmdlast.Enabled = False
cmdnext.Enabled = False
cmdprevious.Enabled = False
cmddelete.Enabled = False

'使各文本框有效
txt_order.Locked = False
cbo_usename.Locked = False
cbo_kind.Locked = False
cbo_xkind.Locked = False
txt_money.Locked = False
DTPicker_date.Enabled = True

'使保存按钮有效
cmdsave.Enabled = True



End Sub

Private Sub cmdnext_Click()
On Error Resume Next
rs.MoveNext
If rs.EOF Then
   MsgBox "已经在数据库最后一条记录!", vbOKOnly + vbInformation, "提示"
   rs.MoveLast
End If
Call viewdata
End Sub

Private Sub cmdok_Click()

End Sub

Private Sub cmdprevious_Click()
On Error Resume Next
rs.MovePrevious
If rs.BOF Then
   MsgBox "已经在数据库第一条记录!", vbOKOnly + vbInformation, "提示"
   rs.MoveFirst
End If
Call viewdata
End Sub

Private Sub cmdsave_Click()


Set db = OpenDatabase(App.Path & "\payout.mdb")
Set rs = db.OpenRecordset("payout")

'判断各输入框的内容是否为空
If Trim$(txt_order.Text) = "" Then
   MsgBox "开支编号不能为空,请输入开支编号!", vbOKOnly + vbExclamation, "警告"
   txt_order.SetFocus
   Exit Sub
End If

If Trim$(DTPicker_date.Value) = "" Then
   MsgBox "开支日期不能为空,请选择开支日期!", vbOKOnly + vbExclamation, "警告"
   DTPicker_date.SetFocus
   Exit Sub
End If

If Trim$(cbo_usename.Text) = "" Then
   MsgBox "开支人不能为空,请选择开支人!", vbOKOnly + vbExclamation, "警告"
   cbo_usename.SetFocus
   Exit Sub
End If

If Trim$(cbo_kind.Text) = "" Then
   MsgBox "开支类别不能为空,请选择开支类别!", vbOKOnly + vbExclamation, "警告"
   cbo_kind.SetFocus
   Exit Sub
End If

If Trim$(cbo_xkind.Text) = "" Then
   MsgBox "开支小类别不能为空,请选择开支类别!", vbOKOnly + vbExclamation, "警告"
   cbo_xkind.SetFocus
   Exit Sub
End If


If Trim$(txt_money.Text) = "" Then
   MsgBox "开支金额不能为空,请输入开支金额!", vbOKOnly + vbExclamation, "警告"
   txt_money.SetFocus
   Exit Sub
End If


'判断开支编号是否输入数字.
If Not IsNumeric(Trim$(txt_order.Text)) Then
   MsgBox "请输入数字,开支编号要是数字!", vbOKOnly + vbExclamation, "警告"
   txt_order.SetFocus
   txt_order.Text = ""
   Exit Sub
End If


'检查有没有修改开支编号

Dim k As Boolean

If Trim$(txt_order.Text) <> txtchange Then
   k = True
Else
   k = False
End If

'检查有没有重复的记录
  Dim db1 As Database
  Dim rst1 As Recordset
  Dim sql As String
  
  Set db1 = OpenDatabase(App.Path & "\payout.mdb")
  sql = "select * from payout where pay_order=" & (txt_order.Text)
  Set rst1 = db.OpenRecordset(sql)
  
If k = True And rst1.EOF = False Then
     MsgBox "开支编号重复,请重新输入", vbOKOnly + vbExclamation, "警告"
     rst1.Close
     txt_order.SetFocus
    '使各按钮有效
    cmdfirst.Enabled = True
    cmdlast.Enabled = True
    cmdnext.Enabled = True
    cmdprevious.Enabled = True
    cmddelete.Enabled = True
    rs.Index = "pay_order"
    '使各文本框无效
    txt_order.Locked = True
    cbo_usename.Locked = True
    cbo_kind.Locked = True
    cbo_xkind.Locked = True
    txt_money.Locked = True
    DTPicker_date.Enabled = False
    Exit Sub
    '使保存按钮无效
    cmdsave.Enabled = False
    
ElseIf k = True And rst1.EOF = True Then
  
  
  Dim sql2 As String
  
  Set db1 = OpenDatabase(App.Path & "\payout.mdb")
  sql2 = "delete * from payout where pay_order = " & txtchange
  db1.Execute (sql2)
  
  With rs
   .AddNew
   !pay_order = txt_order.Text
   !pay_date = DTPicker_date.Value
   !pay_usename = cbo_usename.Text
   !pay_kind = cbo_kind.Text
   !payx_kind = cbo_xkind.Text
   !pay_money = Trim$(txt_money.Text)
   .Update
  End With
   rs.Index = "pay_order"
 
   MsgBox "你已经成功的修改了记录！", vbOKOnly + vbInformation, "提示"
    '使各按钮有效
  cmdfirst.Enabled = True
  cmdlast.Enabled = True
  cmdnext.Enabled = True
  cmdprevious.Enabled = True
  cmddelete.Enabled = True
   '使各文本框无效
    txt_order.Locked = True
    cbo_usename.Locked = True
    cbo_kind.Locked = True
    cbo_xkind.Locked = True
    txt_money.Locked = True
    DTPicker_date.Enabled = False
    '使保存按钮无效
    cmdsave.Enabled = False
Else: k = False
   Do Until rst1.EOF
        rst1.Delete
        rst1.MoveNext
   Loop
   rs.MoveFirst
  With rs
   .AddNew
   !pay_order = txt_order.Text
   !pay_date = DTPicker_date.Value
   !pay_usename = cbo_usename.Text
   !pay_kind = cbo_kind.Text
   !payx_kind = cbo_xkind.Text
   !pay_money = Trim$(txt_money.Text)
   .Update
   rs.Index = "pay_order"
  End With
   MsgBox "你已经成功的修改了记录！", vbOKOnly + vbInformation, "提示"
    '使各按钮有效
  cmdfirst.Enabled = True
  cmdlast.Enabled = True
  cmdnext.Enabled = True
  cmdprevious.Enabled = True
  cmddelete.Enabled = True
 '使各文本框无效
    txt_order.Locked = True
    cbo_usename.Locked = True
    cbo_kind.Locked = True
    cbo_xkind.Locked = True
    txt_money.Locked = True
    DTPicker_date.Enabled = False
  '使保存按钮无效
    cmdsave.Enabled = False
End If
'是保存按钮无效
cmdsave.Enabled = False

End Sub

Private Sub Command1_Click()
rs.Seek "=", txt_order.Text
On Error GoTo kk:
Call viewdata
kk:
End Sub

Private Sub DTPicker_date_Change()
'rs.FindFirst "pay_date=dtpicker_date.value"

End Sub

Private Sub DTPicker_date_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{TAB}"
End If
End Sub

Private Sub Form_Activate()
Dim dkrs As Recordset
Set dkrs = db.OpenRecordset("dkind")
If Not dkrs.EOF Then
   dkrs.MoveFirst
   Do Until dkrs.EOF
       cbo_kind.AddItem Trim$(dkrs!dkind_name)
       dkrs.MoveNext
    Loop
Else
  MsgBox "数据库中没有大类别数据,请在添加!", vbOKOnly + vbInformation, "设置大类别"
End If
End Sub

Private Sub Form_Load()
Set db = OpenDatabase(App.Path & "\payout.mdb")
Set rs = db.OpenRecordset("payout")
If rs.EOF Then
MsgBox "记录表中没有记录，请添加记录！"
Else
rs.MoveFirst


txt_order = rs.Fields("pay_order")
DTPicker_date = rs.Fields("pay_date")
cbo_usename = rs.Fields("pay_usename")
cbo_kind = rs.Fields("pay_kind")
txt_money = rs.Fields("pay_money")
cbo_xkind = rs.Fields("payx_kind")

End If

'使保存按钮无效
cmdsave.Enabled = False

'使各文本框无效
txt_order.Locked = True
cbo_usename.Locked = True
cbo_kind.Locked = True
cbo_xkind.Locked = True
txt_money.Locked = True
DTPicker_date.Enabled = False

rs.Index = ("pay_order")
rs.MoveFirst
Call viewdata
StatusBar1.Panels(3).Text = "总记录为：" & (rs.RecordCount) & "条 " & "当前为：" & ((rs.PercentPosition) + 1) & "条"


End Sub

Private Sub Form_Unload(Cancel As Integer)
frmmain.Show
End Sub

Private Sub Timer1_Timer()
StatusBar1.Panels(2).Text = Time$
StatusBar1.Panels(1).Text = Date$ & WeekdayName(Weekday(Date$), 0, 1)
End Sub

Private Sub txt_money_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
   SendKeys "{TAB}"
End If
End Sub

Private Sub txt_order_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{TAB}"
End If
End Sub