📄 lwjl.frm
字号:
ForeColor = &H00FF0000&
Height = 300
Left = 330
TabIndex = 5
Top = 390
Width = 945
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "姓名："
BeginProperty Font
Name = "楷体_GB2312"
Size = 15
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 300
Left = 2730
TabIndex = 4
Top = 405
Width = 945
End
End
Begin MSForms.CommandButton cmdDelete
Height = 480
Left = 2940
TabIndex = 26
Top = 8010
Width = 1095
VariousPropertyBits= 19
Caption = "删除"
Size = "1931;847"
FontName = "宋体"
FontHeight = 180
FontCharSet = 134
FontPitchAndFamily= 34
ParagraphAlign = 3
End
Begin MSForms.CommandButton cmdAddNext
Height = 495
Left = 5190
TabIndex = 25
Top = 7995
Width = 2280
VariousPropertyBits= 19
Caption = "继续增加来往记录"
Size = "4022;873"
FontName = "宋体"
FontHeight = 180
FontCharSet = 134
FontPitchAndFamily= 34
ParagraphAlign = 3
End
Begin MSForms.CommandButton cmdExit
Height = 465
Left = 9495
TabIndex = 2
Top = 8055
Width = 1005
VariousPropertyBits= 19
Caption = "退出"
Size = "1773;820"
FontName = "宋体"
FontHeight = 180
FontCharSet = 134
FontPitchAndFamily= 34
ParagraphAlign = 3
End
Begin MSForms.CommandButton cmdClear
Height = 480
Left = 7875
TabIndex = 1
Top = 8010
Width = 1095
VariousPropertyBits= 19
Caption = "清空"
Size = "1931;847"
FontName = "宋体"
FontHeight = 180
FontCharSet = 134
FontPitchAndFamily= 34
ParagraphAlign = 3
End
Begin MSForms.CommandButton cmdSave
Height = 480
Left = 1575
TabIndex = 0
Top = 8010
Width = 1050
VariousPropertyBits= 19
Caption = "保存"
Size = "1852;847"
FontName = "宋体"
FontHeight = 180
FontCharSet = 134
FontPitchAndFamily= 34
ParagraphAlign = 3
End
End
Attribute VB_Name = "LWJL"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub CommandButton3_Click()
Dim txt As Control
For Each txt In Controls
If TypeName(txt) = "TextBox" Then
txt.Text = ""
End If
Next txt
Combo1 = ""
End Sub
Private Sub CommandButton4_Click()
Unload Me
End Sub
Private Sub Check1_Click()
If Check1.Value = 1 Then
txtTime = Now
Else
txtTime = ""
End If
End Sub
Private Sub cmdAddnext_Click()
cmdSave.Caption = "保存"
Combo1.Text = ""
txtTime = ""
txtPlace = ""
txtWhat = ""
txtBZ = ""
Call OpenConn
sql = "select * from 来往记录"
rs.Open sql, cn, 3, 3
rs.MoveLast
labJLXH.Caption = rs!记录序号 + 1
Call CloseConn
Call comboAdd
End Sub
Private Sub cmdClear_Click()
Dim txt As Control
For Each txt In Controls
If TypeName(txt) = "TextBox" Then
txt.Text = ""
End If
Next txt
Combo1.Text = ""
End Sub
Private Sub cmdDelete_Click()
'-------------------------先判断序号是否属于该编号的来往记录
Call OpenConn
sql = "select distinct * from 来往记录 where 编号='" & labBH & "' and 记录序号=" & labJLXH
rs.Open sql, cn, 3, 3
If rs.RecordCount < 1 Then
MsgBox "没有相应的记录,请先在列表中选中记录再进行此操作", vbOKOnly + 64, "操作提示"
Exit Sub
End If
Call CloseConn
If MsgBox("是否确定要删除该记录？", vbYesNo + 64, "确认操作") = vbNo Then Exit Sub
Call OpenConn
sql = "select * from 来往记录 where 记录序号=" & labJLXH.Caption
rs.Open sql, cn, 3, 3
If rs.RecordCount > 0 Then
rs.delete
rs.Update
MsgBox "删除成功", vbOKOnly, "操作成功"
Else
MsgBox "没有相应的记录", vbOKOnly, "操作提示"
End If
Call CloseConn
Call AddAllH
Call comboAdd
cmdClear_Click
End Sub
Private Sub cmdExit_Click()
Unload Me
End Sub
Private Sub cmdSave_Click()
Select Case cmdSave.Caption
Case "保存"
'------------------------------------增加记录
Call OpenConn
sql = "select * from 来往记录"
rs.Open sql, cn, 3, 3
rs.AddNew
rs!编号 = labBH.Caption
rs!联系形式 = Combo1.Text
rs!时间 = txtTime
rs!地点 = txtPlace
rs!事件 = txtWhat
rs!备注 = txtBZ
rs.Update
Call CloseConn
'------------------------------------重新加载来往记录
Call AddAllH
'------------------------------------自动编号
Call OpenConn
sql = "select * from 来往记录"
rs.Open sql, cn, 3, 3
rs.MoveLast
labJLXH.Caption = rs!记录序号 + 1
Combo1.Text = ""
txtTime.Text = ""
txtPlace.Text = ""
txtWhat = ""
txtBZ = ""
Call CloseConn
Call comboAdd
Case "修改"
'-----------------------------------修改记录
Call OpenConn
sql = "select * from 来往记录 where 记录序号=" & labJLXH.Caption & " and 编号='" & labBH & "'"
rs.Open sql, cn, 3, 3
If rs.RecordCount > 0 Then
rs!编号 = labBH.Caption
rs!联系形式 = Combo1.Text
rs!时间 = txtTime
rs!地点 = txtPlace
rs!事件 = txtWhat
rs!备注 = txtBZ
rs.Update
Else
MsgBox "请先在列表中选中记录再进行此操作", 0 + 64, "操作提示"
End If
Call CloseConn
'------------------------------------重新加载来往记录
Call AddAllH
End Select
End Sub
Private Sub form_activate()
'---------------------------------初始化联系人信息
Call OpenConn
sql = "select * from 联系人档案 where 编号=" & labBH
rs.Open sql, cn, 3, 3
If rs.RecordCount > 0 Then
labXM.Caption = IIf(IsNull(rs!姓名), "", rs!姓名)
Me.Caption = "为" & labXM.Caption & "添加来往记录"
labDH.Caption = IIf(IsNull(rs!电话), "", rs!电话)
End If
Call CloseConn
'--------------------------------初始化序号
Call OpenConn
sql = "select * from 来往记录"
rs.Open sql, cn, 3, 3
If rs.RecordCount > 0 Then
rs.MoveLast
labJLXH.Caption = IIf(IsNull(rs!记录序号), "", rs!记录序号) + 1
Else
labJLXH.Caption = 1
End If
'---------------------------载入联系人来往记录
Call AddAllH
'--------------------------载入文本框项目
Call comboAdd
End Sub
Private Sub Form_Load()
If QX <> "管理员" And TopRight <> "超级管理员" Then
MsgBox "非管理员没有执行此操作的权限", 0 + 64, "提示"
Exit Sub
End If
Me.Height = 9225
Me.Width = 11640
Me.Top = Screen.Height / 2 - Me.Height / 2 - 800
Me.Left = Screen.Width / 2 - Me.Width / 2
labBH = AddNO
End Sub
Sub AddAllH()
On Error GoTo err
'----------------------------------------------------加载默认列表项目
lv.ColumnHeaders.clear '清除列头
sql = "select * from 来往记录 where 编号='" & labBH & "'"
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
lv.ListItems.clear '清除列表项目
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)), , 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
'----------------------设置前四列列宽
lv.ColumnHeaders(1).Width = 800
lv.ColumnHeaders(2).Width = 800
lv.ColumnHeaders(3).Width = 800
t = 1
err:
If err.Description <> "" Then
MsgBox ""
End If
End Sub
Private Sub lv_click()
On Error GoTo err
labJLXH.Caption = lv.SelectedItem
Call OpenConn
sql = "select * from 来往记录 where 记录序号=" & labJLXH
rs.Open sql, cn, 3, 3
If rs.RecordCount > 0 Then
Combo1.Text = IIf(IsNull(rs!联系形式), "", rs!联系形式)
txtTime = IIf(IsNull(rs!时间), "", rs!时间)
txtPlace = IIf(IsNull(rs!地点), "", rs!地点)
txtWhat = IIf(IsNull(rs!事件), "", rs!事件)
txtBZ = IIf(IsNull(rs!备注), "", rs!备注)
cmdSave.Caption = "修改"
End If
Call CloseConn
err:
If err.Description <> "" Then
MsgBox "列表中项目为空或其他不可预料的错误", vbOKOnly, "错误"
End If
End Sub
Sub comboAdd()
Combo1.clear
Combo1.AddItem "手机"
Combo1.AddItem "座机"
Combo1.AddItem "面谈"
Combo1.AddItem "传真"
Call OpenConn
sql = "select distinct 联系形式 from 来往记录"
rs.Open sql, cn, 3, 3
If rs.RecordCount > 0 Then
Do While Not rs.EOF
If rs!联系形式 <> "手机" And rs!联系形式 <> "座机" And rs!联系形式 <> "面谈" And rs!联系形式 <> "传真" Then
Combo1.AddItem rs!联系形式
End If
rs.MoveNext
Loop
End If
Call CloseConn
End Sub
Private Sub txtTime_click()
Check1.Visible = True
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -