📄 frmls2.frm
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmLs
Caption = "历史记录查询"
ClientHeight = 7350
ClientLeft = 60
ClientTop = 450
ClientWidth = 9315
Icon = "frmLS2.frx":0000
LinkTopic = "Form2"
MDIChild = -1 'True
Picture = "frmLS2.frx":27A2
ScaleHeight = 11010
ScaleWidth = 15240
WindowState = 2 'Maximized
Begin MSComctlLib.ListView LvLs
Height = 5715
Left = 3060
TabIndex = 13
Top = 900
Width = 8715
_ExtentX = 15372
_ExtentY = 10081
LabelEdit = 1
LabelWrap = -1 'True
HideSelection = -1 'True
FullRowSelect = -1 'True
GridLines = -1 'True
_Version = 393217
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
NumItems = 0
End
Begin MSComctlLib.ImageList ImageList1
Left = 600
Top = 6900
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 48
ImageHeight = 48
MaskColor = 16777215
_Version = 393216
BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
NumListImages = 1
BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmLS2.frx":4F44
Key = ""
EndProperty
EndProperty
End
Begin VB.Frame Frame1
Caption = "快速查询"
Height = 795
Left = 30
TabIndex = 0
Top = 60
Width = 11775
Begin VB.PictureBox Picture1
BorderStyle = 0 'None
Height = 495
Left = 120
ScaleHeight = 495
ScaleWidth = 8655
TabIndex = 2
Top = 240
Width = 8655
Begin VB.TextBox txtXm
Height = 315
Left = 840
TabIndex = 10
Top = 60
Width = 1635
End
Begin VB.CommandButton Command1
Caption = "查询"
Default = -1 'True
Height = 375
Left = 3060
TabIndex = 9
Top = 0
Width = 1215
End
Begin VB.OptionButton Option1
Caption = "按姓名查询"
Height = 315
Left = 0
TabIndex = 8
Top = 360
Value = -1 'True
Visible = 0 'False
Width = 1275
End
Begin VB.OptionButton Option2
Caption = "按编号查询"
Height = 375
Left = 0
TabIndex = 7
Top = 540
Width = 1335
End
Begin VB.TextBox txtBh
Alignment = 2 'Center
Height = 270
Left = 2040
TabIndex = 6
Text = "0"
Top = 540
Visible = 0 'False
Width = 675
End
Begin VB.Label Label4
Caption = "以下已经满5年记录的人员"
Height = 315
Left = 5040
TabIndex = 12
Top = 120
Width = 2955
End
Begin VB.Label Label1
Caption = "姓名："
Height = 315
Left = 240
TabIndex = 5
Top = 120
Width = 615
End
Begin VB.Label Label5
Caption = "号"
Height = 195
Left = 2880
TabIndex = 4
Top = 600
Width = 315
End
Begin VB.Label Label3
Caption = "编号："
Height = 315
Left = 1560
TabIndex = 3
Top = 600
Visible = 0 'False
Width = 555
End
End
Begin VB.Label Label2
Height = 435
Left = 540
TabIndex = 1
Top = 300
Visible = 0 'False
Width = 1575
End
End
Begin MSComctlLib.ListView Lv1
Height = 5715
Left = 60
TabIndex = 11
Top = 900
Width = 3015
_ExtentX = 5318
_ExtentY = 10081
LabelWrap = -1 'True
HideSelection = -1 'True
_Version = 393217
Icons = "ImageList1"
ForeColor = -2147483640
BackColor = -2147483644
BorderStyle = 1
Appearance = 1
NumItems = 0
End
End
Attribute VB_Name = "frmLs"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub Command1_Click()
If Option1.Value = True Then
If (InStr(txtXm.Text, "'") > 0) Or (InStr(txtXm.Text, ";")) Then MsgBox "你输入的姓名含非法字符！", 16: Exit Sub
Find "客户名称 Like '%" & txtXm.Text & "%'" & " AND 入会时间<=#" & GetBeginDate & "#"
Else
'Find "编号=" & Val(txtBh.Text) & " AND 入会时间<=#" & GetBeginDate & "#"
End If
End Sub
Private Sub Form_Initialize()
InitCommonControls
End Sub
Private Sub Form_Load()
Dim SQL As String
Dim i As Integer
Dim Dt As String
Dim bgYear As Integer
Dt = GetValue("SELECT MIN(入会时间) FROM 客户表")
bgYear = Year(CDate(Dt))
'========================================================
'Dim Rs As Recordset
'Set Rs = GetRecord("SELECT 帐本编号,帐本 From 帐本表")
'RSToListView Rs, Lv1, False
For i = bgYear To Year(Now) - 5
LV1.ListItems.Add , "KEY" & i, i & "年度", 1
Next
End Sub
Sub GetcusList()
' Dim Zh() As String
' Dim Tmp
'On Error GoTo Er
'lstGK.Clear
'GetList "归类表", "客户名称", Zh, "帐本='" & Lv1.SelectedItem.Text & "'"
'AddToList "SELECT 客户编号,客户名称 From 归类表 Where 帐本='" & Lv1.SelectedItem.Text & "'", lstGK
End Sub
Private Sub lstGK_DblClick()
End Sub
Private Sub Form_Resize()
On Error Resume Next
'DG.Width = Me.ScaleWidth * 0.7
LV1.Height = Me.ScaleHeight - LV1.Top
LvLs.Height = LV1.Height
LvLs.Left = LV1.Width + LV1.Left
LvLs.Width = Me.ScaleWidth - LvLs.Left
'Lv1.Width = Me.ScaleWidth * 0.3
Frame1.Width = Me.Width - Frame1.Left * 3
End Sub
Private Sub Lv1_ItemClick(ByVal Item As MSComctlLib.ListItem)
Dim SQL As String
Dim Nd As Integer
Dim bgDate As Date
Dim EdDate As Date
Nd = Val(VBA.Mid(Item.Key, 4))
bgDate = CDate(Nd & "-1-1")
If Nd = Year(Date) - 5 Then
Dim MM As Integer
Dim DD As Integer
MM = Month(Date)
DD = GetLastDay(Year(Date) - 5, MM)
If MM Mod 3 = 0 Then DD = IIf(Day(Date) < 15, 15, DD)
EdDate = CDate((Year(Date) - 5) & "-" & MM & "-" & DD)
Else
EdDate = CDate(Nd + 1 & "-1-1")
End If
SQL = "入会时间>=#" & bgDate & "# And 入会时间<=#" & EdDate & "#"
Find SQL
End Sub
Private Sub LvLs_DblClick()
If LvLs.ListItems.Count > 0 Then
If LvLs.SelectedItem.Index > 0 Then
Dim Id As Long
Id = CLng(Mid(LvLs.SelectedItem.Key, 4))
frmDj.Cust = Id
frmDj.Show
End If
End If
End Sub
Private Sub Option1_Click()
SetCXTJ
End Sub
Private Sub Option2_Click()
SetCXTJ
End Sub
Private Sub txtXm_GotFocus()
'Command1.Default = True
End Sub
Private Sub txtXm_LostFocus()
'Command1.Default = False
End Sub
Private Sub SetCXTJ()
If Option1.Value = True Then
txtXm.Enabled = True
txtBh.Enabled = False
Else
txtXm.Enabled = False
txtBh.Enabled = True
End If
End Sub
Sub Find(Optional ByVal Con As String = "")
Dim SQL As String
Dim Rs As Recordset
SQL = "SELECT * from 历史查询表"
SQL = SQL & " WHERE 1=1"
If Con <> "" Then
SQL = SQL & " and " & Con
End If
Set Rs = GetRecord(SQL)
RSToListView2 Rs, LvLs
'SQL = SQL & " Order by 编号"
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -