📄 form2.frm
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmML
Caption = "目录"
ClientHeight = 7350
ClientLeft = 60
ClientTop = 450
ClientWidth = 6750
Icon = "form2.frx":0000
LinkTopic = "Form2"
MDIChild = -1 'True
ScaleHeight = 7350
ScaleWidth = 6750
WindowState = 2 'Maximized
Begin MSComctlLib.ListView Lv2
Height = 5715
Left = 3060
TabIndex = 11
Top = 1080
Width = 8055
_ExtentX = 14208
_ExtentY = 10081
LabelEdit = 1
LabelWrap = -1 'True
HideSelection = -1 'True
FullRowSelect = -1 'True
GridLines = -1 'True
PictureAlignment= 5
_Version = 393217
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
NumItems = 0
Picture = "form2.frx":1CFA
End
Begin MSComctlLib.ImageList ImageList1
Left = -60
Top = 1200
_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 = "form2.frx":27E0
Key = ""
EndProperty
EndProperty
End
Begin VB.Frame Frame1
Caption = "快速查询"
Height = 915
Left = 60
TabIndex = 1
Top = 120
Width = 15075
Begin VB.PictureBox Picture1
BorderStyle = 0 'None
Height = 645
Left = 60
ScaleHeight = 645
ScaleWidth = 14895
TabIndex = 2
Top = 240
Width = 14895
Begin VB.CommandButton Command1
Caption = "查找"
Default = -1 'True
Height = 375
Left = 12240
TabIndex = 12
Top = 60
Width = 1515
End
Begin VB.ComboBox cboZb
Height = 315
Left = 960
Style = 2 'Dropdown List
TabIndex = 9
Top = 120
Width = 1155
End
Begin VB.TextBox txtXm
Height = 315
Left = 4380
TabIndex = 6
Top = 120
Width = 1635
End
Begin VB.OptionButton Option1
Caption = "按姓名查询"
Height = 315
Left = 2520
TabIndex = 5
Top = 120
Value = -1 'True
Width = 1275
End
Begin VB.OptionButton Option2
Caption = "按编号查询"
Height = 315
Left = 6240
TabIndex = 4
Top = 120
Width = 1275
End
Begin VB.TextBox txtBh
Alignment = 2 'Center
Enabled = 0 'False
Height = 270
Left = 8340
TabIndex = 3
Text = "0"
Top = 120
Width = 675
End
Begin VB.Shape Shape1
Height = 435
Index = 1
Left = 180
Top = 60
Width = 2175
End
Begin VB.Label Label2
Caption = "范围："
Height = 255
Left = 420
TabIndex = 10
Top = 180
Width = 675
End
Begin VB.Shape Shape2
Height = 435
Left = 6180
Top = 60
Width = 2955
End
Begin VB.Shape Shape1
Height = 435
Index = 0
Left = 2400
Top = 60
Width = 3735
End
Begin VB.Label Label1
Caption = "姓名："
Height = 315
Left = 3840
TabIndex = 8
Top = 180
Width = 615
End
Begin VB.Label Label3
Caption = "编号："
Height = 315
Left = 7740
TabIndex = 7
Top = 180
Width = 555
End
End
End
Begin MSComctlLib.ListView Lv1
Height = 5715
Left = 60
TabIndex = 0
Top = 1080
Width = 3015
_ExtentX = 5318
_ExtentY = 10081
LabelWrap = -1 'True
HideSelection = -1 'True
PictureAlignment= 5
_Version = 393217
Icons = "ImageList1"
ForeColor = -2147483640
BackColor = -2147483644
BorderStyle = 1
Appearance = 1
NumItems = 0
Picture = "form2.frx":36BA
End
End
Attribute VB_Name = "frmML"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
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 '%" & Trim(txtXm.Text) & "%'", True
ElseIf Option2.Value = True Then
Find "编号=" & Val(txtBh.Text), True
Else
' Dim S As String
' S = "客户名称 Like '%" & txtXM2.Text & "%'"
' S = S & " AND Exists(SELECT * FROM 汇款表 WHERE 客户表.客户编号=汇款表.客户编号)"
' Find S, True
End If
End Sub
Private Sub Command2_Click()
MsgBox GetMonthNo(CDate(Text1.Text))
End Sub
Private Sub Form_GotFocus()
Dim Rs As Recordset
Set Rs = GetRecord("SELECT 帐本编号,帐本 From 帐本表")
RSToListView Rs, LV1, False
End Sub
Private Sub Form_Initialize()
InitCommonControls
End Sub
Private Sub Form_Load()
Dim SQL As String
'========================================================
Dim Rs As Recordset
Set Rs = GetRecord("SELECT 帐本编号,帐本 From 帐本表")
RSToListView Rs, LV1, False
AddZbToList
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 HFG_DblClick()
Dim R As Integer
Dim Id As Integer
'Dim C As Integer
R = HFG.Row
HFG.Col = 0
Id = HFG.Text
'MsgBox ID
End Sub
Private Sub lstGK_DblClick()
End Sub
Private Sub Form_Resize()
On Error Resume Next
LV2.Width = Me.ScaleWidth - LV2.Left
LV2.Height = Me.ScaleHeight - LV2.Top
LV1.Height = LV2.Height
LV2.Left = LV1.Width
Frame1.Width = Me.Width - Frame1.Left * 3
End Sub
Private Sub Lv1_ItemClick(ByVal Item As MSComctlLib.ListItem)
Dim SQL As String
Dim i As Integer
Dim ZB As Integer
ZB = Val(VBA.Mid(Item.Key, 4))
Find "所在帐本=" & ZB
For i = 1 To cboZb.ListCount - 1
If cboZb.ItemData(i) = ZB Then
cboZb.ListIndex = i
Exit For
End If
Next
End Sub
Private Sub LV2_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
If LV2.SortOrder = lvwAscending Then
LV2.SortOrder = lvwDescending
Else
LV2.SortOrder = lvwAscending
End If
'Lv2.Sorted = True
LV2.SortKey = ColumnHeader.SubItemIndex
End Sub
Private Sub LV2_DblClick()
If LV2.ListItems.Count > 0 Then
If LV2.SelectedItem.Index > 0 Then
Dim Id As Long
Id = CLng(Mid(LV2.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 txtBn_Change()
Dim sel As Integer
sel = Val(txtBn)
If sel > 0 Then
If sel <= LV1.ListItems.Count Then
LV1.ListItems(sel).Selected = True
End If
End If
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 = "", Optional ByVal blFind As Boolean = False)
Dim SQL As String
Dim Rs As Recordset
'主SQL语句
If blFind = False Then
SQL = "SELECT 客户编号,编号,客户名称,电话号码,手机号码,入会时间 from 客户表"
Else
SQL = "SELECT * from 明细表2"
End If
SQL = SQL & " WHERE 1=1"
'blFind参数代表是否从上面查找
If blFind = True Then
If cboZb.ListIndex > 0 Then
SQL = SQL & " AND 客户编号 IN(SELECT 客户编号 From 客户表 WHERE 所在帐本=" & cboZb.ItemData(cboZb.ListIndex) & ")" ' 所在帐本=" & cboZb.ItemData(cboZb.ListIndex)
End If
End If
If Con <> "" Then
SQL = SQL & " AND " & Con
End If
'SQL = SQL & " AND 入会时间>#" & GetBeginDate & "#"
SQL = SQL & " Order by 编号"
Set Rs = GetRecord(SQL)
RSToListView2 Rs, LV2
If blFind = False Then
LV2.ColumnHeaders(1).Width = 600
Else
LV2.ColumnHeaders(2).Width = 600
End If
End Sub
'这个过程的功能是把记录集的内容显示在ListView上
Private Sub RSToListView(objRs As Recordset, LV As ListView, ByVal withTitle As Boolean)
Dim i As Long
Dim j As Long
Dim K As Long
LV1.ListItems.Clear
If objRs.State <> 0 Then
If Not (objRs.EOF And objRs.BOF) Then
Do While Not objRs.EOF
LV.ListItems.Add , "Key" & objRs.Fields(0).Value, objRs.Fields(1).Value, 1
objRs.MoveNext
Loop
End If
End If
End Sub
Private Sub AddZbToList()
cboZb.AddItem "所有", 0
cboZb.ItemData(0) = "-1"
Dim i As Integer
Dim Rs As Recordset
Set Rs = GetRecord("SELECT * FROM 帐本表")
i = 1
Do While Not Rs.EOF
cboZb.AddItem Rs.Fields(1).Value, i
cboZb.ItemData(i) = Rs.Fields(0)
i = i + 1
Rs.MoveNext
Loop
cboZb.ListIndex = 0
mdCom.Release
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -