📄 frm_srcx.frm
字号:
BackColor = &H0080C0FF&
Caption = "日期："
Height = 672
Left = 2640
TabIndex = 16
Top = 960
Width = 4665
Begin MSComCtl2.DTPicker DTPicker1
Height = 285
Index = 0
Left = 540
TabIndex = 8
Top = 240
Width = 1755
_ExtentX = 3096
_ExtentY = 503
_Version = 393216
Format = 56295424
CurrentDate = 36801
End
Begin MSComCtl2.DTPicker DTPicker1
Height = 285
Index = 1
Left = 2745
TabIndex = 9
Top = 240
Width = 1755
_ExtentX = 3096
_ExtentY = 503
_Version = 393216
Format = 56295424
CurrentDate = 36801
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "到"
Height = 180
Index = 1
Left = 2415
TabIndex = 18
Top = 300
Width = 180
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "从"
Height = 180
Index = 0
Left = 276
TabIndex = 17
Top = 288
Width = 180
End
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "客人姓名："
Height = 180
Index = 7
Left = 156
TabIndex = 25
Top = 684
Width = 900
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "支付方式："
Height = 180
Index = 6
Left = 4980
TabIndex = 24
Top = 300
Width = 900
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "介绍人："
Height = 180
Index = 5
Left = 2640
TabIndex = 23
Top = 300
Width = 720
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "项 目："
Height = 180
Index = 4
Left = 156
TabIndex = 22
Top = 288
Width = 924
End
End
Begin VB.Label Label2
BackColor = &H00C0E0FF&
BorderStyle = 1 'Fixed Single
Height = 255
Left = 120
TabIndex = 27
Top = 1950
Width = 8850
End
End
Attribute VB_Name = "frm_srcx"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim itmx As ListItem
'Dim db As Database
Dim rec As Recordset
Dim sqlstr As String
Private Sub OKButton_Click()
End Sub
Private Sub Check1_Click()
Frame2.Visible = Check1.Value
End Sub
Private Sub Check2_Click()
Frame3.Visible = Check2.Value
End Sub
Private Sub Combo1_GotFocus(Index As Integer)
If Index = 0 Then
Combo1(Index).SelStart = 0
Combo1(idnex).SelLength = Len(Combo1(Index))
'Combo1(Index).IMEMode = 1
End If
End Sub
Private Sub Command1_Click(Index As Integer)
On Error GoTo jgqerr
Select Case Index
Case 0 '查询
If Check2.Value And Check1.Value Then
sqlstr = "select * from 收入表 where 日期>=#" & DTPicker1(0).Value & "# and 日期<=#" & DTPicker1(1).Value & "# and 卡号>=" + Trim(Text1(0)) + " and 卡号<=" + Trim(Text1(1)) + " and 项目 like '*" + Trim(Text2(0)) + "*' and 介绍人 like '*" + Combo1(0) + "*' and 支付方式 like '" + IIf(Combo1(1).Text = "", "*", Combo1(1).Text) + "' and 客人姓名 like '*" + Trim(Text2(1)) + "*'"
sqlstr1 = "select count(*) from 收入表 where 日期>=#" & DTPicker1(0).Value & "# and 日期<=#" & DTPicker1(1).Value & "# and 卡号>=" + Trim(Text1(0)) + " and 卡号<=" + Trim(Text1(1)) + " and 项目 like '*" + Trim(Text2(0)) + "*' and 介绍人 like '*" + Combo1(0) + "*' and 支付方式 like '" + IIf(Combo1(1).Text = "", "*", Combo1(1).Text) + "' and 客人姓名 like '*" + Trim(Text2(1)) + "*'"
Else
If Check2.Value And Check1.Value = 0 Then
sqlstr = "select * from 收入表 where 卡号>=" + Trim(Text1(0)) + " and 卡号<=" + Trim(Text1(1)) + " and 项目 like '*" + Trim(Text2(0)) + "*' and 介绍人 like '*" + Combo1(0) + "*' and 支付方式 like '" + IIf(Combo1(1).Text = "", "*", Combo1(1).Text) + "' and 客人姓名 like '*" + Trim(Text2(1)) + "*'"
sqlstr1 = "select count(*) from 收入表 where 卡号>=" + Trim(Text1(0)) + " and 卡号<=" + Trim(Text1(1)) + " and 项目 like '*" + Trim(Text2(0)) + "*' and 介绍人 like '*" + Combo1(0) + "*' and 支付方式 like '" + IIf(Combo1(1).Text = "", "*", Combo1(1).Text) + "' and 客人姓名 like '*" + Trim(Text2(1)) + "*'"
Else
If Check1.Value And Check2.Value = 0 Then
sqlstr = "select * from 收入表 where 日期>=#" & DTPicker1(0).Value & "# and 日期<=#" & DTPicker1(1).Value & "# and 项目 like '*" + Trim(Text2(0)) + "*' and 介绍人 like '*" + Combo1(0) + "*' and 支付方式 like '" + IIf(Combo1(1).Text = "", "*", Combo1(1).Text) + "' and 客人姓名 like '*" + Trim(Text2(1)) + "*'"
sqlstr1 = "select count(*) from 收入表 where 日期>=#" & DTPicker1(0).Value & "# and 日期<=#" & DTPicker1(1).Value & "# and 项目 like '*" + Trim(Text2(0)) + "*' and 介绍人 like '*" + Combo1(0) + "*' and 支付方式 like '" + IIf(Combo1(1).Text = "", "*", Combo1(1).Text) + "' and 客人姓名 like '*" + Trim(Text2(1)) + "*'"
Else
sqlstr = "select * from 收入表 where 项目 like '*" + Trim(Text2(0)) + "*' and 介绍人 like '*" + Combo1(0) + "*' and 支付方式 like '" + IIf(Combo1(1).Text = "", "*", Combo1(1).Text) + "' and 客人姓名 like '*" + Trim(Text2(1)) + "*'"
sqlstr1 = "select count(*) from 收入表 where 项目 like '*" + Trim(Text2(0)) + "*' and 介绍人 like '*" + Combo1(0) + "*' and 支付方式 like '" + IIf(Combo1(1).Text = "", "*", Combo1(1).Text) + "' and 客人姓名 like '*" + Trim(Text2(1)) + "*'"
End If
End If
End If
Me.MousePointer = 11
Set rec = db.OpenRecordset(sqlstr1)
jrsn = rec.Fields(0)
Set rec = db.OpenRecordset(sqlstr)
ProgressBar1.Visible = True
ListView1.ListItems.Clear
zje = 0
Do While Not rec.EOF
Set itmx = ListView1.ListItems.Add(, , Format(rec.Fields("日期"), "yyyy-mm-dd"))
For i = 1 To rec.Fields.Count - 1
itmx.SubItems(i) = IIf(IsNull(rec.Fields(i)), "", rec.Fields(i))
If i = 5 Then
zje = zje + rec.Fields(5)
End If
Next i
ProgressBar1.Value = (rec.AbsolutePosition + 1) / jrsn * 100
rec.MoveNext
Loop
ProgressBar1.Visible = False
Me.MousePointer = 0
If ListView1.ListItems.Count = 0 Then
Command1(1).Enabled = False
Command1(2).Enabled = False
MsgBox "没有您要查找的记录", vbOKOnly + vbInformation, "提示"
Else
Command1(1).Enabled = True
Command1(2).Enabled = True
ListView1.SortKey = 0
ListView1.SortOrder = lvwAscending
ListView1.Sorted = True
End If
Label2 = "总共查找到： " & jrsn & " 条 收入总金额： " & Format(zje, "###,###,###.00") & " ￥"
Case 1 '打印
yw_nr = Label2.Caption
SaveSetting "奇迹公司", "页眉/页尾", "页尾打印", "1"
dytr_main Me, 1, Me.Caption, "收入表"
Case 2 '删除
If ListView1.ListItems.Count = 0 Then
MsgBox "没有记录供您删除", vbOKOnly + vbCritical, "错误"
Exit Sub
End If
If MsgBox("真的想删除列表中的记录吗？", vbYesNo + vbQuestion + vbDefaultButton2, "提示") = vbNo Then
Exit Sub
End If
sqlstr = Right(sqlstr, Len(sqlstr) - 6)
sqlstr = "delete" + sqlstr
db.Execute sqlstr
ListView1.ListItems.Clear
Command1(1).Enabled = False
Command1(2).Enabled = False
Case 3
Unload Me
End Select
Exit Sub
jgqerr:
MsgBox Err.Description, vbOKOnly + vbCritical, "错误"
End Sub
Private Sub Form_Load()
frm_main.srtj.Enabled = False
'frm_main.Toolbar2.Buttons(7).Enabled = False
frmcen Me
DTPicker1(0).Value = Date - 30
DTPicker1(1).Value = Date
'Set db = OpenDatabase(AppPath + "datas\mry.mdb")
Set rec = db.OpenRecordset("select distinct 介绍人 from 收入表")
Combo1(0).AddItem ""
Do While Not rec.EOF
Combo1(0).AddItem rec.Fields("介绍人")
rec.MoveNext
Loop
If Combo1(0).ListCount <> 0 Then
Combo1(0).ListIndex = 0
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
frm_main.srtj.Enabled = True
'frm_main.Toolbar2.Buttons(7).Enabled = True
'db.Close
'Set db = Nothing
End Sub
Private Sub ListView1_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
ListView1.SortKey = ColumnHeader.Index - 1
yn = MsgBox("将按照『" + ColumnHeader.Text + "』排序" + Chr(13) + "是否按升序排列,按[否]将按降序排列", vbYesNo + vbQuestion, "提示")
If yn = vbNo Then
ListView1.SortOrder = lvwDescending
Else
ListView1.SortOrder = lvwAscending
End If
ListView1.Sorted = True
End Sub
Private Sub Text2_GotFocus(Index As Integer)
Text2(Index).SelStart = 0
Text2(idnex).SelLength = Len(Text2(Index))
'Text2(Index).IMEMode = 1
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -