?? pldel.frm
字號:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Object = "{0D452EE1-E08F-101A-852E-02608C4D0BB4}#2.0#0"; "FM20.DLL"
Begin VB.Form PLDEL
BackColor = &H00FFC0C0&
Caption = "批量刪除聯系人"
ClientHeight = 8700
ClientLeft = 60
ClientTop = 450
ClientWidth = 12015
LinkTopic = "Form1"
MaxButton = 0 'False
MDIChild = -1 'True
ScaleHeight = 8700
ScaleWidth = 12015
Begin VB.TextBox Text1
BeginProperty Font
Name = "宋體"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 330
Left = 5235
TabIndex = 6
Top = 465
Width = 2070
End
Begin VB.ComboBox Combo1
BeginProperty Font
Name = "宋體"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 360
Left = 1620
TabIndex = 5
Text = "所有項目"
Top = 480
Width = 2085
End
Begin VB.CommandButton Command4
Caption = "全部取消"
Height = 570
Left = 3825
TabIndex = 4
Top = 7590
Width = 1725
End
Begin VB.CommandButton Command3
Caption = "退出"
Height = 555
Left = 9240
TabIndex = 3
Top = 7620
Width = 1920
End
Begin VB.CommandButton Command2
Caption = "刪除選中聯系人"
Height = 570
Left = 6585
TabIndex = 2
Top = 7590
Width = 1980
End
Begin VB.CommandButton Command1
Caption = "全選"
Height = 570
Left = 1035
TabIndex = 1
Top = 7605
Width = 1725
End
Begin MSComctlLib.ListView lv
Height = 6120
Left = 930
TabIndex = 0
Top = 1170
Width = 10260
_ExtentX = 18098
_ExtentY = 10795
View = 3
LabelEdit = 1
MultiSelect = -1 'True
LabelWrap = -1 'True
HideSelection = -1 'True
Checkboxes = -1 'True
FullRowSelect = -1 'True
GridLines = -1 'True
_Version = 393217
Icons = "ImageList1"
SmallIcons = "ImageList1"
ColHdrIcons = "ImageList1"
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
NumItems = 0
End
Begin MSComctlLib.ImageList ImageList1
Left = 0
Top = 0
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 32
ImageHeight = 32
MaskColor = 12632256
_Version = 393216
BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
NumListImages = 1
BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "PLDEL.frx":0000
Key = ""
EndProperty
EndProperty
End
Begin VB.Label Label2
BackStyle = 0 'Transparent
Caption = "條件"
BeginProperty Font
Name = "宋體"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 285
Left = 915
TabIndex = 9
Top = 510
Width = 630
End
Begin VB.Label Label3
BackStyle = 0 'Transparent
Caption = "關鍵字"
BeginProperty Font
Name = "宋體"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 285
Left = 4350
TabIndex = 8
Top = 525
Width = 945
End
Begin MSForms.CommandButton cmd_CZ
Height = 405
Left = 8115
TabIndex = 7
Top = 480
Width = 1290
VariousPropertyBits= 19
Caption = "檢索"
Size = "2275;714"
FontName = "宋體"
FontHeight = 180
FontCharSet = 134
FontPitchAndFamily= 34
ParagraphAlign = 3
End
Begin VB.Shape Shape1
BorderColor = &H00FFFFFF&
Height = 8415
Left = 570
Top = 90
Width = 10965
End
End
Attribute VB_Name = "PLDEL"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Combo1_click()
Text1.SetFocus
End Sub
Private Sub Text1_gotfocus()
Text1.IMEMode = 1
End Sub
Private Sub Text1_keypress(KeyAscii As Integer)
If KeyAscii = 13 Then
cmd_CZ_Click
End If
End Sub
Private Sub cmd_CZ_Click()
On Error GoTo err
lv.ListItems.clear
'-----------------------------當查詢條件為“所有項目時"
If Combo1 = "所有項目" Then
Me.lv.ListItems.clear '先清空listview
Call OpenConn
sql = "select * from 聯系人檔案"
rs.Open sql, cn, 3, 3
For i = 0 To rs.Fields.Count - 1
xmmc = rs.Fields(i).Name
Call OpenConn1
sql1 = "select * from 聯系人檔案 where " & xmmc & " like '%" & Text1 & "%'"
rs1.Open sql1, cn1, 3, 3
If rs1.RecordCount > 0 Then
Do While Not rs1.EOF
Set Item = lv.FindItem(rs1.Fields("編號"), , , lvwPartial) '判斷是否是重復客戶
If Item Is Nothing Then
it = 1
Else
it = 0
End If
If it = 1 Then
Set addlist = lv.ListItems.add(, , IIf(IsNull(rs1.Fields(rs1.Fields(0).Name)), "", rs1.Fields(rs1.Fields(0).Name)), , 1)
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
Call CloseConn1
Next i
Call CloseConn
Exit Sub
End If
'-----------------------------當查詢條件不為“所有項目時"
Call OpenConn
sql = "select * from 聯系人檔案 where " & Combo1 & " like '%" & Text1 & "%'"
rs.Open sql, cn, 3, 3
If rs.RecordCount > 0 Then
Do While Not rs.EOF
Set addlist = lv.ListItems.add(, , IIf(IsNull(rs.Fields(rs.Fields(0).Name)), "", rs.Fields(rs.Fields(0).Name)), , 1)
For u = 1 To rs.Fields.Count - 1
addlist.SubItems(u) = IIf(IsNull(rs.Fields(rs.Fields(u).Name)), "", rs.Fields(rs.Fields(u).Name))
Next u
rs.MoveNext
Loop
End If
err:
If err.Description <> "" Then
MsgBox "操作錯誤，請檢查你的查詢條件", vbOKOnly, "提示"
End If
End Sub
Private Sub Command1_Click()
Dim nitem As ListItem
For n = 1 To lv.ListItems.Count
With lv
.ListItems.Item(n).Checked = True
End With
Next n
End Sub
Private Sub Command2_Click()
Call delxx
ZJM.RefreshList.Value = True
End Sub
Private Sub Command3_Click()
Unload Me
End Sub
Private Sub Command4_Click()
Dim nitem As ListItem
For n = 1 To lv.ListItems.Count
With lv
.ListItems.Item(n).Checked = False
End With
Next n
End Sub
Private Sub Form_Load()
Me.Height = 9210
Me.Width = 12135
Me.Top = Screen.Height / 2 - Me.Height / 2 - 400
Me.Left = Screen.Width / 2 - Me.Width / 2
sql = "select * from 聯系人檔案"
Call OpenConn
rs.Open sql, cn, 3, 3
Me.lv.ListItems.clear
For i = 0 To rs.Fields.Count - 1
Me.lv.ColumnHeaders.add = rs.Fields(i).Name
Next i
lv.ColumnHeaders(1).Width = 800
If rs.RecordCount > 0 Then
Do While Not rs.EOF
Set addlist = lv.ListItems.add(, , IIf(IsNull(rs.Fields(rs.Fields(0).Name)), "", rs.Fields(rs.Fields(0).Name)), , 1)
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
'----------------------設置前六列列寬
lv.ColumnHeaders(1).Width = 800
lv.ColumnHeaders(2).Width = 800
lv.ColumnHeaders(3).Width = 800
lv.ColumnHeaders(4).Width = 1000
lv.ColumnHeaders(5).Width = 1600
lv.ColumnHeaders(6).Width = 1600
lv.ColumnHeaders(7).Width = 800
lv.ColumnHeaders(8).Width = 1600
'----------------------加載可選查詢條件
Combo1.AddItem "所有項目"
sql = "select * from 聯系人檔案"
Call OpenConn
rs.Open sql, cn, 3, 3
For i = 0 To rs.Fields.Count - 1
Combo1.AddItem rs.Fields(i).Name
Next i
Call CloseConn
End Sub
Sub delxx() '刪除選中項目過程模塊
Dim nCount As Integer
Dim nIndex As Integer
Dim oitem As ListItem
If lv.ListItems.Count = 0 Then
MsgBox "列表中沒有可操作的項目！", vbOKOnly, "提示"
Exit Sub
End If
If MsgBox("此操作將刪除所有選中項目的聯系人信息以及來往記錄，是否繼續操作？", vbYesNo, "確認刪除") = vbNo Then Exit Sub
With lv
nCount = .ListItems.Count
For nIndex = nCount To 1 Step -1
If .ListItems.Item(nIndex).Selected = True Or .ListItems.Item(nIndex).Checked = True Then
'------------------------------------------------------刪除對應編號聯系人
Call OpenConn
sql = "select * from 聯系人檔案 where 編號=" & .ListItems.Item(nIndex).Text
rs.Open sql, cn, 3, 3
rs.delete
rs.Update
Call CloseConn
'------------------------------------------------------刪除對應編號聯系人的來往記錄
Call OpenConn
sql = "select * from 來往記錄 where 編號='" & .ListItems.Item(nIndex).Text & "'"
rs.Open sql, cn, 3, 3
Do While Not rs.EOF
rs.delete
rs.Update
rs.MoveNext
Loop
Call CloseConn
'------------------------------------------------------列表中刪除選中項
.ListItems.Remove nIndex '
End If
Next
End With
End Sub
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -