frmquery.frm

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

  
  Dim rs5 As Recordset
  Set rs5 = db.OpenRecordset("select sum(pay_money) as total from  payout where pay_date " & Trim$(cboqu_date.Text) & "#" & Trim$(DTPqu_date.Value) & "#")
  If rs5.RecordCount = 0 Then
      MsgBox "按你所指定的条件查询没有记录,请重新设置条件查询!", vbOKOnly + vbInformation, "查询没有记录"
      Exit Sub
   End If
  Lbl1.Caption = "你查询到" & (rs3.RecordCount) & "条记录" & "总金额为:" & rs5.Fields(0) & "元"
  rs3.Close
  rs5.Close
End Sub

'以下一段代码是实现按种类查询
Sub query_kind():
 rs.Index = ("pay_order")
  Set db = OpenDatabase(App.Path & "\payout.mdb")
  Dim sql As String
  sql = "select * from payout where  pay_kind='" & cbokind_qu.Text & "'"
  Set rs4 = db.OpenRecordset(sql)
 If rs4.RecordCount = 0 Then
      MsgBox "按你所指定的条件查询没有记录,请重新设置条件查询!", vbOKOnly + vbInformation, "查询没有记录"
      Exit Sub
   End If
  With dataset
  .Rows = 1
  .Cols = 6
  .CellAlignment = 4
  .ColWidth(3) = 1500
  .TextMatrix(0, 0) = "开支编号"
  .TextMatrix(0, 1) = "开支日期"
  .TextMatrix(0, 2) = "开支人"
 .TextMatrix(0, 3) = "开支大种类"
  .TextMatrix(0, 4) = "开支小种类"
  .TextMatrix(0, 5) = "开支金额"
  Do While Not rs4.EOF
    .Rows = .Rows + 1
    .CellAlignment = 4
    .TextMatrix(.Rows - 1, 0) = rs4.Fields(0)
    .TextMatrix(.Rows - 1, 1) = Format(rs4.Fields(1), "yyyy-mm-dd")
    .TextMatrix(.Rows - 1, 2) = rs4.Fields(2)
    .TextMatrix(.Rows - 1, 3) = rs4.Fields(3)
    .TextMatrix(.Rows - 1, 4) = rs4.Fields(5)
    .TextMatrix(.Rows - 1, 5) = Format(rs4.Fields(4), "0.00")
  '  .TextMatrix(.Rows, 6) = Format(rs4.Fields(4), "0.00")
     rs4.MoveNext
  Loop
  End With
  
  '计算查询到的总金额
  Dim rs5 As Recordset
  Set rs5 = db.OpenRecordset("select sum(pay_money) as total from payout where  pay_kind='" & cbokind_qu.Text & "'")
  If rs5.RecordCount = 0 Then
      MsgBox "按你所指定的条件查询没有记录,请重新设置条件查询!", vbOKOnly + vbInformation, "查询没有记录"
      Exit Sub
   End If
  Lbl1.Caption = "你查询到" & (rs4.RecordCount) & "条记录" & "总金额为:" & rs5.Fields(0) & "元"
  rs4.Close
  rs5.Close
End Sub


Private Sub Form_Activate()
rs.Index = ("pay_order")
Dim dkrs As Recordset
Set dkrs = db.OpenRecordset("dkind")
If Not dkrs.EOF Then
   dkrs.MoveFirst
   Do Until dkrs.EOF
       cbokind_qu.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")
Set rs1 = db.OpenRecordset("select distinct pay_kind from payout")
rs.Index = ("pay_order")
With dataset
.Rows = 1
.Cols = 6
.CellAlignment = 4
  .ColWidth(3) = 1500
  .TextMatrix(0, 0) = "开支编号"
  .TextMatrix(0, 1) = "开支日期"
  .TextMatrix(0, 2) = "开支人"
 .TextMatrix(0, 3) = "开支大种类"
  .TextMatrix(0, 4) = "开支小种类"
  .TextMatrix(0, 5) = "开支金额"
Do While Not rs.EOF
   .Rows = .Rows + 1
   .CellAlignment = 4
   .TextMatrix(.Rows - 1, 0) = rs.Fields(0)
   .TextMatrix(.Rows - 1, 1) = Format(rs.Fields(1), "yyyy-mm-dd")
   .TextMatrix(.Rows - 1, 2) = rs.Fields(2)
   .TextMatrix(.Rows - 1, 3) = rs.Fields(3)
   .TextMatrix(.Rows - 1, 4) = rs.Fields(5)
   .TextMatrix(.Rows - 1, 5) = Format(rs.Fields(4), "0.00")
rs.MoveNext
Loop
End With
  
  '使各文本框无效
   cbokind_qu.Enabled = False
   txtqu_order.Enabled = False
   cboqu_order.Enabled = False
   cboqu_date.Enabled = False
   DTPqu_date.Enabled = False
 rs.Index = ("pay_order")
'自动算出开支编号
' 判断现在是几月，来决定开支编号中月份的写法
Dim yue As String
If Month(Date) >= 10 Then
   yue = Month(Date)
Else
   yue = "0" & Month(Date)
End If
txtqu_order.Text = Year(Date$) & yue & "001"
'设置当前日期
DTPqu_date.Value = Date$
End Sub


Private Sub cmdquit_Click()
Unload Me
frmmain.Show
End Sub

Private Sub cmdsearch_Click()
'判断用户选择了那种查询方式
Set db = OpenDatabase(App.Path & "\payout.mdb")
Set rs = db.OpenRecordset("payout")
Dim a As String

If (opt_order.Value = False) And (opt_date.Value = False) And (opt_kind.Value = False) Then
    a = MsgBox("确定不选择查询条件，而查询所有的数据吗？", vbYesNo + vbInformation, "提示")
    If a = vbYes Then
       With dataset
       .Rows = 1
       .Cols = 6
       .CellAlignment = 4
      .ColWidth(3) = 1500
      .TextMatrix(0, 0) = "开支编号"
      .TextMatrix(0, 1) = "开支日期"
      .TextMatrix(0, 2) = "开支人"
      .TextMatrix(0, 3) = "开支大种类"
      .TextMatrix(0, 4) = "开支小种类"
      .TextMatrix(0, 5) = "开支金额"
         Do While Not rs.EOF
            .Rows = .Rows + 1
            .CellAlignment = 4
            .TextMatrix(.Rows - 1, 0) = rs.Fields(0)
            .TextMatrix(.Rows - 1, 1) = Format(rs.Fields(1), "yyyy-mm-dd")
            .TextMatrix(.Rows - 1, 2) = rs.Fields(2)
            .TextMatrix(.Rows - 1, 3) = rs.Fields(3)
            .TextMatrix(.Rows - 1, 4) = rs.Fields(5)
            .TextMatrix(.Rows - 1, 5) = Format(rs.Fields(4), "0.00")
            rs.MoveNext
         Loop
       End With
    Else
       Exit Sub
    End If
End If
   
  Set db = OpenDatabase(App.Path & "\payout.mdb")
  Dim rs5 As Recordset
  Set rs5 = db.OpenRecordset("select sum(pay_money) as total from payout")
  If rs5.RecordCount = 0 Then
      MsgBox "按你所指定的条件查询没有记录,请重新设置条件查询!", vbOKOnly + vbInformation, "查询没有记录"
      Exit Sub
   End If
  Lbl1.Caption = "你查询到" & (rs.RecordCount) & "条记录" & "总金额为:" & rs5.Fields(0) & "元"
  rs5.Close

If (opt_order.Value = True) And (cboqu_order.Text <> "") And (txtqu_order.Text <> "") Then
        Call query_order
ElseIf (opt_date.Value = True) And (cboqu_date.Text <> "") And (DTPqu_date.Value <> "") Then
        Call query_date
ElseIf (opt_kind.Value = True) And (cbokind_qu.Text <> "") Then
        Call query_kind
Else
       cmdsearch.SetFocus
'MsgBox "查询条件不能为空，请选择条件！", vbOKOnly + vbInformation, "提示"
End If

End Sub

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

Private Sub opt_date_Click()
'使别的查询框无效,使与该单选框对应的文本框有效
If opt_date.Value = True Then
   DTPqu_date.Enabled = True
   txtqu_order.Enabled = False
   cbokind_qu.Enabled = False
   cboqu_order.Enabled = False
   cboqu_date.Enabled = True
End If
End Sub

Private Sub opt_kind_Click()
'使别的查询框无效,使与该单选框对应的文本框有效
If opt_kind.Value = True Then
   cbokind_qu.Enabled = True
   DTPqu_date.Enabled = False
   txtqu_order.Enabled = False
   cboqu_order.Enabled = False
   cboqu_date.Enabled = False
End If
End Sub

Private Sub opt_order_Click()
'使别的查询框无效,使与该单选框对应的文本框有效
If opt_order.Value = True Then
   txtqu_order.Enabled = True
   cboqu_order.Enabled = True
   DTPqu_date.Enabled = False
   cbokind_qu.Enabled = False
   cboqu_date.Enabled = False
End If
End Sub