📄 form1.frm
字号:
Top = 1005
Width = 720
End
Begin VB.Shape Shape3
BorderColor = &H000000FF&
BorderStyle = 3 'Dot
Height = 1725
Left = 8265
Top = 780
Width = 2535
End
Begin VB.Shape Shape2
BorderColor = &H000000FF&
BorderStyle = 3 'Dot
Height = 1725
Left = 4695
Top = 750
Width = 2535
End
Begin VB.Shape Shape1
BorderColor = &H000000FF&
BorderStyle = 3 'Dot
FillColor = &H00FFC0C0&
Height = 1725
Left = 1020
Top = 795
Width = 2535
End
Begin VB.Label Label2
Caption = "关键字"
BeginProperty Font
Name = "楷体_GB2312"
Size = 15.75
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 405
Left = -74700
TabIndex = 2
Top = 1455
Width = 1215
End
Begin VB.Label findHistory
Caption = "条件"
BeginProperty Font
Name = "楷体_GB2312"
Size = 15.75
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 345
Left = -74640
TabIndex = 1
Top = 885
Width = 855
End
End
Begin VB.Menu menuF
Caption = "功能菜单"
Begin VB.Menu Belong
Caption = "【查看所属联系人信息】"
End
Begin VB.Menu sd
Caption = "-"
End
Begin VB.Menu editThis
Caption = "【修改】"
Shortcut = ^E
End
Begin VB.Menu ww
Caption = "-"
End
Begin VB.Menu sAll
Caption = "【全选】"
Shortcut = ^A
End
Begin VB.Menu ew
Caption = "-"
End
Begin VB.Menu DeleteS
Caption = "【删除选中】"
Shortcut = {DEL}
End
Begin VB.Menu rew
Caption = "-"
End
Begin VB.Menu lookAll
Caption = "【显示全部来往记录】"
Shortcut = ^R
End
End
End
Attribute VB_Name = "findHistory"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim sqlH
Dim sqlH1
Dim sqlH2
Dim Log1
Dim Log2
Dim listV As Control
Private Sub Belong_Click()
On Error GoTo err
Call OpenConn
lvNo = listV.SelectedItem
sql = "select distinct * from 来往记录 where 记录序号=" & lvNo
rs.Open sql, cn, 3, 3
If rs.RecordCount > 0 Then
SelectNo = rs!编号
End If
Call CloseConn
ReDim infoarr(i)
Set infoarr(i) = New Class1
Set infoarr(i).newForm = New infoma
Load infoarr(i).newForm
err:
If err.Description <> "" Then
MsgBox "没有选中项目！", 0 + 64, "Error"
End If
End Sub
Private Sub cmdAll_Click()
For i = 1 To 7
CheckBox2(i).Value = 1
Next i
End Sub
Private Sub cmdCancel_Click()
For i = 1 To 7
CheckBox2(i).Value = 0
Next i
End Sub
Private Sub cmdClear_Click()
logicKeyWord1 = ""
logicKeyWord2 = ""
logicKeyWord3 = ""
End Sub
Private Sub DeleteS_Click()
If QX <> "管理员" And TopRight <> "超级管理员" Then
MsgBox "非管理员没有执行此操作的权限", 0 + 64, "提示"
Exit Sub
End If
Call delHxx
End Sub
Private Sub EditThis_Click()
On Error GoTo err
If QX <> "管理员" And TopRight <> "超级管理员" Then
MsgBox "非管理员没有执行此操作的权限", 0 + 64, "提示"
Exit Sub
End If
hNO = listV.SelectedItem
Dim i As Long
ReDim infoarr(i)
Set infoarr(i) = New Class1
Set infoarr(i).newForm = New LWJLedit
Load infoarr(i).newForm
err:
If err.Description <> "" Then
MsgBox "列表中没有项目或没有选中项目", 0 + 64, "Error"
End If
End Sub
Private Sub fixCZ_Click()
lv1.ListItems.clear
For i = 1 To 7
If CheckBox2(i).Value Then
xmmc = CheckBox2(i).Caption
Call OpenConn1
sql1 = "select * from 来往记录 where " & xmmc & " like '%" & fixKeyWord & "%'"
rs1.Open sql1, cn1, 3, 3
If rs1.RecordCount > 0 Then
Do While Not rs1.EOF
Set Item = lv1.FindItem(rs1.Fields("记录序号"), , , lvwPartial) '判断是否是重复客户
If Item Is Nothing Then
it = 1
Else
it = 0
End If
If it = 1 Then
Set addlist = lv1.ListItems.add(, , IIf(IsNull(rs1.Fields(rs1.Fields(0).Name)), "", rs1.Fields(rs1.Fields(0).Name)), , 0)
For h = 1 To rs1.Fields.Count - 1
addlist.SubItems(h) = IIf(IsNull(rs1.Fields(rs1.Fields(h).Name)), "", rs1.Fields(rs1.Fields(h).Name))
Next h
End If
rs1.MoveNext
Loop
End If
End If
Next i
Label4.Caption = "查询结果：" & lv1.ListItems.Count & "条记录"
End Sub
Private Sub Form_Load()
Me.Width = 15240
Me.Height = 9825
Me.Top = Screen.Height / 2 - Me.Height / 2 - 800
Me.Left = Screen.Width / 2 - Me.Width / 2
sqlH = "select * from 来往记录"
sqlH1 = "select * from 来往记录"
sqlH2 = "select * from 来往记录"
Call addxx
Call addxx1
Call Addxx2
'--------------------------------简单查询条件列表加载
simpleCombo = "所有项目"
simpleCombo.AddItem "所有项目"
sql = "select * from 来往记录"
Call OpenConn
rs.Open sql, cn, 3, 3
For i = 0 To rs.Fields.Count - 1
simpleCombo.AddItem rs.Fields(i).Name
logicCombo1.AddItem rs.Fields(i).Name
logicCombo2.AddItem rs.Fields(i).Name
logicCombo3.AddItem rs.Fields(i).Name
Next i
Call CloseConn
'--------------------------------逻辑组合查询条件列表加载
logicCombo4.AddItem "且"
logicCombo4.AddItem "或"
logicCombo4.AddItem "非"
logicCombo5.AddItem "且"
logicCombo5.AddItem "或"
logicCombo5.AddItem "非"
End Sub
Private Sub Option2_Click()
For i = 1 To 7
CheckBox2(i).Value = 0
Next i
End Sub
Private Sub lookAll_Click()
On Error GoTo err
Call OpenConn
sql = "select distinct * from 来往记录"
rs.Open sql, cn, 1, 1
listV.ListItems.clear '清除列表项目
If rs.RecordCount > 0 Then
Do While Not rs.EOF
Set addlist = listV.ListItems.add(, , IIf(IsNull(rs.Fields(rs.Fields(0).Name)), "", rs.Fields(rs.Fields(0).Name)), , 0)
For k = 1 To rs.Fields.Count - 1
addlist.SubItems(k) = IIf(IsNull(rs.Fields(rs.Fields(k).Name)), "", rs.Fields(rs.Fields(k).Name))
Next k
rs.MoveNext
Loop
End If
Call CloseConn
err:
If err.Description <> "" Then
End If
End Sub
Private Sub lv2_mousedown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then
Set listV = lv2
PopupMenu menuF
End If
End Sub
Private Sub lv2_dblclick()
On Error GoTo err
Set listV = lv2
Belong_Click
err:
If err.Description <> "" Then
MsgBox "列表中没有项目", vbOKOnly + 61, "提示"
End If
End Sub
Private Sub lv1_mousedown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then
Set listV = lv1
PopupMenu menuF
End If
End Sub
Private Sub lv1_dblclick()
On Error GoTo err
Set listV = lv1
Belong_Click
err:
If err.Description <> "" Then
MsgBox "列表中没有项目", vbOKOnly + 61, "提示"
End If
End Sub
Private Sub lv_mousedown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then
Set listV = lv
PopupMenu menuF
End If
End Sub
Private Sub lv_dblclick()
On Error GoTo err
Set listV = lv
Belong_Click
err:
If err.Description <> "" Then
MsgBox "列表中没有项目", vbOKOnly + 61, "提示"
End If
End Sub
Private Sub sAll_Click()
On Error GoTo err
Dim nitem As ListItem
For n = 1 To listV.ListItems.Count
With listV
.ListItems.Item(n).Checked = True
.ListItems.Item(n).Selected = True
End With
Next n
err:
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -