?? 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 + -