?? 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 + -