📄 frmquery.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 frmquery
BorderStyle = 1 'Fixed Single
Caption = "记录查询"
ClientHeight = 5760
ClientLeft = 45
ClientTop = 330
ClientWidth = 6495
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
ScaleHeight = 5760
ScaleWidth = 6495
StartUpPosition = 2 '屏幕中心
Begin VB.OptionButton opt_date
Caption = "开支日期"
Height = 180
Left = 3000
TabIndex = 10
Top = 480
Width = 1095
End
Begin VB.OptionButton opt_kind
Caption = "开支种类"
Height = 255
Left = 0
TabIndex = 9
Top = 840
Width = 1095
End
Begin VB.OptionButton opt_order
Caption = "开支编号"
Height = 180
Left = 0
TabIndex = 8
Top = 480
Width = 1095
End
Begin MSHierarchicalFlexGridLib.MSHFlexGrid dataset
Height = 4215
Left = 120
TabIndex = 7
Top = 1320
Width = 6135
_ExtentX = 10821
_ExtentY = 7435
_Version = 393216
Cols = 5
_NumberOfBands = 1
_Band(0).Cols = 5
End
Begin VB.ComboBox cbokind_qu
Height = 300
ItemData = "frmquery.frx":0000
Left = 1200
List = "frmquery.frx":0002
TabIndex = 6
Top = 720
Width = 1695
End
Begin VB.CommandButton cmdquit
Caption = "退出"
Height = 375
Left = 5640
TabIndex = 5
Top = 720
Width = 735
End
Begin VB.CommandButton cmdsearch
Caption = "查询"
Height = 375
Left = 4680
TabIndex = 4
Top = 720
Width = 735
End
Begin MSComCtl2.DTPicker DTPqu_date
Height = 270
Left = 4920
TabIndex = 3
Top = 360
Width = 1455
_ExtentX = 2566
_ExtentY = 476
_Version = 393216
Format = 23658497
CurrentDate = 37942
End
Begin VB.ComboBox cboqu_date
Height = 300
ItemData = "frmquery.frx":0004
Left = 4080
List = "frmquery.frx":001A
TabIndex = 2
Top = 360
Width = 735
End
Begin VB.ComboBox cboqu_order
Height = 300
ItemData = "frmquery.frx":0033
Left = 1200
List = "frmquery.frx":0049
TabIndex = 1
Top = 360
Width = 615
End
Begin VB.TextBox txtqu_order
Height = 270
Left = 1920
TabIndex = 0
Top = 360
Width = 975
End
Begin VB.Label Lbl1
Height = 495
Left = 3000
TabIndex = 12
Top = 720
Width = 1695
End
Begin VB.Label Lblinfo
Caption = "查询提示：请先选择查询类别，然后选查询条件，再按查询按钮！"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 255
Left = 0
TabIndex = 11
Top = 0
Width = 7455
End
End
Attribute VB_Name = "frmquery"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim db As Database
Dim rs As Recordset '所有的记录
Dim rs1 As Recordset '所有记录的种类列表
Dim txtsql As String
Dim rs2 As Recordset '按编号查询的记录集
Dim rs3 As Recordset '按日期查询的记录集
Dim rs4 As Recordset '按种类查询的记录集
'以下一段代码是实现按编号查询
Sub query_order():
rs.Index = ("pay_order")
Set db = OpenDatabase(App.Path & "\payout.mdb")
Set rs2 = db.OpenRecordset("select * from payout where " & Trim$("pay_order") & Trim$(cboqu_order.Text) & (txtqu_order.Text))
If rs2.RecordCount = 0 Then
MsgBox "按你所指定的条件查询没有记录,请重新设置条件查询!", vbOKOnly + vbInformation, "查询没有记录"
Exit Sub
End If
With dataset
.Rows = 1
.Cols = 6
.ColWidth(3) = 1500
.CellAlignment = 4
.TextMatrix(0, 0) = "开支编号"
.TextMatrix(0, 1) = "开支日期"
.TextMatrix(0, 2) = "开支人"
.TextMatrix(0, 3) = "开支大种类"
.TextMatrix(0, 4) = "开支小种类"
.TextMatrix(0, 5) = "开支金额"
Do While Not rs2.EOF
.Rows = .Rows + 1
.CellAlignment = 4
.TextMatrix(.Rows - 1, 0) = rs2.Fields(0)
.TextMatrix(.Rows - 1, 1) = Format(rs2.Fields(1), "yyyy-mm-dd")
.TextMatrix(.Rows - 1, 2) = rs2.Fields(2)
.TextMatrix(.Rows - 1, 3) = rs2.Fields(3)
.TextMatrix(.Rows - 1, 4) = rs2.Fields(5)
.TextMatrix(.Rows - 1, 5) = Format(rs2.Fields(4), "0.00")
rs2.MoveNext
Loop
End With
'计算查询到的总金额
Dim rs5 As Recordset
Set rs5 = db.OpenRecordset("select sum(pay_money) as total from payout where " & Trim$("pay_order") & Trim$(cboqu_order.Text) & (txtqu_order.Text))
If rs5.RecordCount = 0 Then
MsgBox "按你所指定的条件查询没有记录,请重新设置条件查询!", vbOKOnly + vbInformation, "查询没有记录"
Exit Sub
End If
Lbl1.Caption = "你查询到" & (rs2.RecordCount) & "条记录" & "总金额为:" & rs5.Fields(0) & "元"
rs2.Close
rs5.Close
End Sub
'以下一段代码是实现按日期查询
Sub query_date():
'Dim sql As String
rs.Index = ("pay_order")
Set db = OpenDatabase(App.Path & "\payout.mdb")
'sql = "select * from payout where " & "pay_date <= " & "#" & Year(Date$) & "-" & Month(Date$) & "-" & "31" & " # " & " And " & "pay_date >= " & "#" & Year(Date$) & "-" & Month(Date$) & "-" & "01" & " #"
'sql = "select * from payout where pay_date >= " & "#" & Year(Date$) & "-" & Month(Date$) & "-" & "01" & " #"
sql = "select * from payout where pay_date " & Trim$(cboqu_date.Text) & "#" & Trim$(DTPqu_date.Value) & "#"
Set rs3 = db.OpenRecordset(sql)
If rs3.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 rs3.EOF
.Rows = .Rows + 1
.CellAlignment = 4
.TextMatrix(.Rows - 1, 0) = rs3.Fields(0)
.TextMatrix(.Rows - 1, 1) = Format(rs3.Fields(1), "yyyy-mm-dd")
.TextMatrix(.Rows - 1, 2) = rs3.Fields(2)
.TextMatrix(.Rows - 1, 3) = rs3.Fields(3)
.TextMatrix(.Rows - 1, 4) = rs3.Fields(5)
.TextMatrix(.Rows - 1, 5) = Format(rs3.Fields(4), "0.00")
rs3.MoveNext
Loop
End With
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -