📄 frmaddper.frm
字号:
TabIndex = 25
Top = 2400
Width = 975
End
Begin VB.Label Label6
Caption = "地 址:"
Height = 375
Left = 4080
TabIndex = 24
Top = 1800
Width = 975
End
Begin VB.Label Label5
Caption = "生 日:"
Height = 375
Left = 480
TabIndex = 23
Top = 1800
Width = 975
End
Begin VB.Label Label4
Caption = "性 别:"
Height = 375
Left = 480
TabIndex = 22
Top = 1200
Width = 975
End
Begin VB.Label Label3
Caption = "年 龄:"
Height = 375
Left = 4080
TabIndex = 21
Top = 1200
Width = 975
End
Begin VB.Label Label2
Caption = "姓 名:"
Height = 375
Left = 4080
TabIndex = 20
Top = 600
Width = 975
End
End
End
Attribute VB_Name = "frmAddPer"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private num As Integer '记录编号
Private iComNum As Integer '公司编号
Private binputFlag As Boolean '输入判断标志
Private Sub createNum() '产生编号
Dim sql As String
Dim rs As New ADODB.Recordset
Dim strNum As String
sql = "select * from Personal order by ID"
Set rs = getRS(sql)
If rs.EOF = True Then
num = 1
Else
rs.MoveLast
num = rs(0) + 1
End If
strNum = "C" & Right((10000000 + num), 7)
Me.textClientID = strNum
rs.Close
End Sub
Private Sub getCompany() '载入时获得公司信息
Dim sql As String
Dim rs As New ADODB.Recordset
sql = "select * from Company order by ID"
Set rs = getRS(sql)
If rs.EOF = False Then
With Me.comComName
While Not rs.EOF
.AddItem rs(1)
rs.MoveNext
Wend
.ListIndex = 0
End With
Else
Exit Sub
End If
rs.Close
End Sub
Private Sub init() '重新初始化
Me.textName.SetFocus
Me.textName = ""
Me.textAddress = ""
Me.textAge = ""
Me.textBirthday = ""
Me.textCode = ""
Me.textEmail = ""
Me.textMobileTel = ""
Me.textPerFax = ""
Me.textPerTel = ""
Me.textPosition = ""
Me.comGender.ListIndex = 0
End Sub
Private Sub cmdCancel_Click()
Unload Me
Exit Sub
End Sub
Private Sub checkInput() '判断输入
If Me.textDomain = "" Then
MsgBox "请输入领域！", vbOKOnly + vbExclamation, "提示"
Me.textDomain.SetFocus
ElseIf Me.textCountry = "" Then
MsgBox "请输入国家", vbOKOnly + vbExclamation, "提示"
Me.textCountry.SetFocus
ElseIf Me.textCity = "" Then
MsgBox "请输入城市", vbOKOnly + vbExclamation, "提示"
Me.textCity.SetFocus
ElseIf Me.textComAddress = "" Then
MsgBox "请输入公司地址", vbOKOnly + vbExclamation, "提示"
Me.textComAddress.SetFocus
ElseIf Me.textComTel = "" Then
MsgBox "请输入公司电话", vbOKOnly + vbExclamation, "提示"
Me.textComTel.SetFocus
ElseIf Me.textSymbiosis = "" Then
MsgBox "请输入合作范围", vbOKOnly + vbExclamation, "提示"
Me.textSymbiosis.SetFocus
ElseIf Me.textName = "" Then
MsgBox "请输入客户名称", vbOKOnly + vbExclamation, "提示"
Me.textName.SetFocus
ElseIf Me.textAddress = "" Then
MsgBox "请输入个人地址", vbOKOnly + vbExclamation, "提示"
Me.textAddress.SetFocus
ElseIf Me.textPerTel = "" Then
MsgBox "请输入个人电话", vbOKOnly + vbExclamation, "提示"
Me.textPerTel.SetFocus
ElseIf Me.textCode = "" Then
MsgBox "请输入邮编", vbOKOnly + vbExclamation, "提示"
Me.textCode.SetFocus
ElseIf Me.textPosition = "" Then
MsgBox "请输入职务", vbOKOnly + vbExclamation, "提示"
Me.textPosition.SetFocus
Else
binputFlag = True
End If
End Sub
Private Sub cmdOK_Click()
Dim sql As String
Dim rs As New ADODB.Recordset
binputFlag = False
Call checkInput
If binputFlag = True Then
If ichangeFlag = 1 Then
Call addCompany
Call addPerson
Call createNum
Call init
Else
sql = "select * from Company where ComName='" & Me.comComName.Text & "'"
Set rs = getRS(sql)
If rs.EOF = True Then
Call addCompany
End If
sql = "update Personal set ClientName='" & Me.textName & "',Gender='"
sql = sql & Me.comGender.Text & "',Age=" & Me.textAge
sql = sql & ",Company='" & Me.comComName.Text
sql = sql & "',CPosition='" & Me.textPosition & "',Address='" & Me.textAddress
sql = sql & "',Code='" & Me.textCode & "',Tel='" & Me.textPerTel
sql = sql & "',MobileTel='" & Me.textMobileTel & "',FaxNumber='"
sql = sql & Me.textPerFax & "',Email='" & Me.textEmail & "'"
If Me.textBirthday <> "" Then
sql = sql & ",Birthday=#" & Me.textBirthday & "#"
End If
sql = sql & " where ClientID='" & Me.textClientID & "'"
Call TransactSQL(sql) '修改个人信息
MsgBox "已经修改客户信息！", vbOKOnly + vbExclamation, "提示"
Unload Me
sql = "select * from Personal where ClientID='" & Me.textClientID & "'"
Call frmPerResult.showTopic '显示结果
Call frmPerResult.showData(sql)
frmPerResult.ZOrder 0
End If
End If
End Sub
Private Sub comComName_LostFocus() '获得公司信息
Dim sql As String
Dim rs As New ADODB.Recordset
sql = "select * from Company where ComName='" & Me.comComName.Text & "'"
Set rs = getRS(sql)
If rs.EOF = False Then
Me.textDomain = rs(4)
Me.textCountry = rs(2)
Me.textCity = rs(3)
Me.textSymbiosis = rs(5)
Me.textComAddress = rs(6)
Me.textComTel = rs(7)
Me.textComFax = rs(8)
Me.textRemark = rs(9)
Else
Me.textDomain.SetFocus
Exit Sub
End If
rs.Close
End Sub
Private Sub addCompany() '添加公司信息
Dim sql As String
Dim rs As New ADODB.Recordset
sql = "select * from Company where ComName='" & Me.comComName.Text & "'"
Set rs = getRS(sql)
If rs.EOF = False Then
Exit Sub
Else
rs.AddNew
rs.Fields(0) = num
rs.Fields(1) = Me.comComName.Text
rs.Fields(2) = Me.textCountry
rs.Fields(3) = Me.textCity
rs.Fields(4) = Me.textDomain
rs.Fields(5) = Me.textSymbiosis
rs.Fields(6) = Me.textComAddress
rs.Fields(7) = Me.textComTel
rs.Fields(8) = Me.textComFax
rs.Fields(9) = Me.textRemark
rs.Update
rs.Close
End If
End Sub
Private Sub addPerson() '添加个人信息
Dim sql As String
Dim rs As New ADODB.Recordset
sql = "select * from Personal where ClientName='" & Me.textName
sql = sql & "' and Tel='" & Me.textPerTel & "' and Company='"
sql = sql & Me.comComName.Text & "'"
Set rs = getRS(sql)
If rs.EOF = False Then
MsgBox "已经存在这个客户的信息！", vbOKOnly + vbExclamation, "提示"
Else
rs.AddNew
rs.Fields(0) = num
rs.Fields(1) = Me.textClientID
rs.Fields(2) = Me.textName
rs.Fields(3) = Me.comGender.Text
rs.Fields(4) = Me.textAge
rs.Fields(5) = Me.textBirthday
rs.Fields(6) = Me.comComName.Text
rs.Fields(7) = Me.textPosition
rs.Fields(8) = Me.textAddress
rs.Fields(9) = Me.textCode
rs.Fields(10) = Me.textPerTel
rs.Fields(11) = Me.textMobileTel
rs.Fields(12) = Me.textPerFax
rs.Fields(13) = Me.textEmail
rs.Update
rs.Close
MsgBox "已经添加记录！", vbOKOnly + vbExclamation, "提示"
End If
End Sub
Private Sub Form_Load() '载入窗体时初始化
Dim sql As String
Dim rs As New ADODB.Recordset
Dim rsCompany As New ADODB.Recordset
If ichangeFlag = 1 Then
Me.Caption = "添加客户信息"
Call getCompany
Call createNum
With Me.comGender
.AddItem "男"
.AddItem "女"
.ListIndex = 0
End With
Else
Set rs = getRS(strPublicSQL)
If rs.EOF = False Then
sql = "select * from Company where ComName='" & rs(6) & "'"
Set rsCompany = getRS(sql)
If rsCompany.EOF = False Then
iComNum = rs(0)
Me.comComName.Text = rsCompany(1) '显示公司信息
Me.textCountry = rsCompany(2)
Me.textCity = rsCompany(3)
Me.textDomain = rsCompany(4)
Me.textSymbiosis = rsCompany(5)
Me.textComAddress = rsCompany(6)
Me.textComTel = rsCompany(7)
Me.textComFax = rsCompany(8)
Me.textRemark = rsCompany(9)
Me.textClientID = rs.Fields(1) '显示客户个人信息
Me.textName = rs.Fields(2)
Me.comGender.Text = rs.Fields(3)
If IsNull(rs.Fields(4)) = False Then
Me.textAge = rs.Fields(4)
Else
Me.textAge = ""
End If
If rs.Fields(5) <> "0:00:00" Then
Me.textBirthday = rs.Fields(5)
Else
Me.textBirthday = ""
End If
Me.comComName.Text = rs.Fields(6)
Me.textPosition = rs.Fields(7)
Me.textAddress = rs.Fields(8)
Me.textCode = rs.Fields(9)
Me.textPerTel = rs.Fields(10)
If IsNull(rs.Fields(11)) = False Then '判断是否为空
Me.textMobileTel = rs.Fields(11)
Else
Me.textMobileTel = ""
End If
If IsNull(rs.Fields(12)) = False Then
Me.textPerFax = rs.Fields(12)
Else
Me.textPerFax = ""
End If
If IsNull(rs.Fields(13)) = False Then
Me.textEmail = rs.Fields(13)
Else
Me.textEmail = ""
End If
End If
rsCompany.Close
End If
rs.Close
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -