📄 frmadd.frm
字号:
VERSION 5.00
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomct2.ocx"
Begin VB.Form FrmAdd
BorderStyle = 1 'Fixed Single
Caption = "增加"
ClientHeight = 5385
ClientLeft = 45
ClientTop = 330
ClientWidth = 9615
Icon = "FrmAdd.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MDIChild = -1 'True
ScaleHeight = 5385
ScaleWidth = 9615
Begin VB.Frame FramAdd
Height = 5460
Left = 0
TabIndex = 7
Top = -90
Width = 9600
Begin VB.CommandButton CommClear
Caption = "清除"
Height = 375
Left = 4005
TabIndex = 19
Top = 4725
Width = 1500
End
Begin VB.ComboBox CombOk
Height = 300
ItemData = "FrmAdd.frx":0442
Left = 7740
List = "FrmAdd.frx":0444
Style = 2 'Dropdown List
TabIndex = 18
Top = 1620
Width = 1680
End
Begin VB.CommandButton CommExit
Caption = "退出"
Height = 375
Left = 6435
TabIndex = 16
Top = 4725
Width = 1500
End
Begin VB.CommandButton CommAdd
Caption = "添加"
Height = 375
Left = 1485
TabIndex = 15
Top = 4725
Width = 1500
End
Begin VB.TextBox TxtComp
Height = 330
Left = 1260
TabIndex = 0
Top = 450
Width = 8160
End
Begin VB.TextBox TxtLinkm
Height = 330
Left = 1260
TabIndex = 1
Top = 1035
Width = 1680
End
Begin VB.TextBox TxtPhone
Height = 330
Left = 1260
TabIndex = 4
Top = 1620
Width = 4785
End
Begin VB.TextBox TxtEmail
Height = 330
Left = 4365
TabIndex = 2
Top = 1035
Width = 1680
End
Begin VB.TextBox TxtAddress
Height = 330
Left = 1260
TabIndex = 5
Top = 2205
Width = 8160
End
Begin VB.TextBox TxtContent
Height = 1455
Left = 1260
MaxLength = 250
MultiLine = -1 'True
TabIndex = 6
Top = 2790
Width = 8160
End
Begin MSComCtl2.DTPicker DT_ckdate
Height = 330
Left = 7740
TabIndex = 3
Top = 1035
Width = 1680
_ExtentX = 2963
_ExtentY = 582
_Version = 393216
Format = 24707073
CurrentDate = 37417
MaxDate = 402133
MinDate = 36526
End
Begin VB.Label LabOK
Caption = "业务情况"
Height = 180
Left = 6525
TabIndex = 17
Top = 1695
Width = 720
End
Begin VB.Line LWhite
BorderColor = &H00FFFFFF&
X1 = 200
X2 = 9400
Y1 = 4500
Y2 = 4500
End
Begin VB.Line LBlack
BorderColor = &H00808080&
X1 = 200
X2 = 9400
Y1 = 4510
Y2 = 4510
End
Begin VB.Label LabComp
Caption = "公司名称"
ForeColor = &H00FF0000&
Height = 180
Left = 270
TabIndex = 14
Top = 525
Width = 720
End
Begin VB.Label LabAddress
Caption = "详细地址"
ForeColor = &H00FF0000&
Height = 180
Left = 270
TabIndex = 13
Top = 2250
Width = 720
End
Begin VB.Label LabLinkman
Caption = "联 系 人"
ForeColor = &H00FF0000&
Height = 180
Left = 270
TabIndex = 12
Top = 1110
Width = 720
End
Begin VB.Label LabPhone
Caption = "电 话"
ForeColor = &H00FF0000&
Height = 180
Left = 270
TabIndex = 11
Top = 1695
Width = 630
End
Begin VB.Label LabEmail
Caption = "@Email"
Height = 180
Left = 3285
TabIndex = 10
Top = 1110
Width = 540
End
Begin VB.Label LabrDate
Caption = "洽谈日期"
Height = 180
Left = 6525
TabIndex = 9
Top = 1110
Width = 720
End
Begin VB.Label LabContent
Caption = "备 注"
Height = 180
Left = 270
TabIndex = 8
Top = 3420
Width = 720
End
End
End
Attribute VB_Name = "FrmAdd"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub CommAdd_Click()
CommAdd.Enabled = False
CommExit.Enabled = False
CommClear.Enabled = False
If TxtComp.Text = "" Then
TxtComp.SetFocus
MsgBox " 请填写公司名称！ ", , "公司名称"
Exit Sub
End If
If TxtLinkm.Text = "" Then
TxtLinkm.SetFocus
MsgBox " 请填写联系人！ ", , "联系人"
Exit Sub
End If
If TxtPhone.Text = "" Then
TxtPhone.SetFocus
MsgBox " 请填写电话 ！ ", , "电话"
Exit Sub
End If
If TxtAddress.Text = "" Then
TxtAddress.SetFocus
MsgBox " 请填写详细地址 ！ ", , "详细地址"
Exit Sub
End If
'------------------------------------------------
Dim Sql As String
Dim Rst As New ADODB.Recordset
Sql = "SELECT Company FROM Operation WHERE Company='" & ClearStr(TxtComp.Text) & "'"
Set Rst = Conn.Execute(Sql)
If Rst.EOF Then
Sql = "INSERT INTO Operation (Company,Linkman,Address,Phone,Email,tDate,[upDate],Status,Content) " _
& "VALUES ('" & ClearStr(TxtComp.Text) & "'," _
& "'" & ClearStr(TxtLinkm.Text) & "'," _
& "'" & ClearStr(TxtAddress.Text) & "'," _
& "'" & ClearStr(TxtPhone.Text) & "'," _
& "'" & ClearStr(TxtEmail.Text) & "'," _
& "'" & FormatDT(DT_ckdate.Value) & "'," _
& "'" & FormatDT(Date) & "'," _
& CombOk.ListIndex & "," _
& "'" & ClearStr(TxtContent.Text) & "')"
Conn.Execute Sql
CommClear.Value = True
Else
MsgBox " 此公司已经存在！ "
End If
CommAdd.Enabled = True
CommExit.Enabled = True
CommClear.Enabled = True
End Sub
Private Sub CommClear_Click()
Dim i As Integer
For i = 0 To Controls.Count - 1
If Left(Controls(i).Name, 3) = "Txt" Then
Controls(i).Text = ""
End If
Next
DT_ckdate.Value = Date
CombOk.ListIndex = 0
End Sub
Private Sub CommExit_Click()
Unload Me
End Sub
Private Sub Form_Load()
EButton "000"
GetFrm Me, "Add", 200, 600, 9705, 5760
DT_ckdate.Value = Date
With CombOk
.AddItem "没有开始"
.AddItem "进 行 中"
.AddItem "洽谈成功"
.ListIndex = 0
End With
End Sub
Private Sub Form_Unload(Cancel As Integer)
EButton "111"
SaveFrm Me, "Add"
End Sub
Private Sub TxtAddress_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then TxtContent.SetFocus
End Sub
Private Sub TxtComp_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then TxtLinkm.SetFocus
End Sub
Private Sub TxtEmail_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then TxtPhone.SetFocus
End Sub
Private Sub TxtLinkm_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then TxtEmail.SetFocus
End Sub
Private Sub TxtPhone_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then TxtPhone2.SetFocus
End Sub
Private Sub TxtPhone2_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then TxtAddress.SetFocus
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -