📄 frmkh.frm
字号:
VERSION 5.00
Begin VB.Form frmkh
Caption = "客户信息管理"
ClientHeight = 5205
ClientLeft = 60
ClientTop = 345
ClientWidth = 5865
LinkTopic = "Form1"
ScaleHeight = 5205
ScaleWidth = 5865
StartUpPosition = 3 '窗口缺省
Begin VB.Frame Frame1
Height = 735
Left = 120
TabIndex = 16
Top = 4200
Width = 5535
Begin VB.CommandButton cmdClose
Caption = "返回"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 3720
TabIndex = 9
Top = 240
Width = 1095
End
Begin VB.CommandButton Command8
Caption = "重设"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 840
TabIndex = 7
Top = 240
Width = 1095
End
Begin VB.CommandButton Command3
Caption = "保存"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 2280
TabIndex = 8
Top = 240
Width = 1095
End
End
Begin VB.Frame Frame5
Caption = "客户信息管理"
Height = 3735
Left = 120
TabIndex = 0
Top = 240
Width = 5535
Begin VB.TextBox TextKF
Height = 1335
Index = 5
Left = 1560
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 6
Top = 2160
Width = 3615
End
Begin VB.TextBox TextKF
Height = 270
Index = 4
Left = 1560
TabIndex = 5
Top = 1800
Width = 3615
End
Begin VB.TextBox TextKF
Height = 270
Index = 3
Left = 1560
TabIndex = 4
Top = 1440
Width = 2535
End
Begin VB.TextBox TextKF
Height = 270
Index = 2
Left = 1560
TabIndex = 3
Top = 1080
Width = 2535
End
Begin VB.TextBox TextKF
Height = 270
Index = 1
Left = 1560
TabIndex = 2
Top = 720
Width = 2535
End
Begin VB.TextBox TextKF
Height = 270
Index = 0
Left = 1560
TabIndex = 1
Top = 360
Width = 2535
End
Begin VB.Label LabKF
Caption = "备注："
Height = 255
Index = 5
Left = 360
TabIndex = 15
Top = 2160
Width = 1095
End
Begin VB.Label LabKF
Caption = "联系地址："
Height = 255
Index = 4
Left = 360
TabIndex = 14
Top = 1800
Width = 1095
End
Begin VB.Label LabKF
Caption = "手机："
Height = 255
Index = 3
Left = 360
TabIndex = 13
Top = 1440
Width = 1095
End
Begin VB.Label LabKF
Caption = "电话："
Height = 255
Index = 2
Left = 360
TabIndex = 12
Top = 1080
Width = 1095
End
Begin VB.Label LabKF
Caption = "姓名："
Height = 255
Index = 1
Left = 360
TabIndex = 11
Top = 720
Width = 1095
End
Begin VB.Label LabKF
Caption = "用户编号："
Height = 255
Index = 0
Left = 360
TabIndex = 10
Top = 360
Width = 1095
End
End
End
Attribute VB_Name = "frmkh"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'****************************************************************************
'人人为我，我为人人
'枕善居收藏整理
'发布日期：2006/12/06
'描 述： 纯净水进销存管理系统 Ver 2.0
'网 站：http://www.Mndsoft.com/ (VB6源码博客)
'网 站：http://www.VbDnet.com/ (VB.NET源码博客,主要基于.NET2005)
'e-mail ：Mndsoft@163.com
'e-mail ：Mndsoft@126.com
'OICQ ：88382850
' 如果您有新的好的代码别忘记给枕善居哦!
'****************************************************************************
Private Sub cmdchange_Click()
Dim sqlKF As String
Dim i As Integer
For i = 1 To 4
If TextKF(i).Text = "" Then
TextKF(i).SetFocus
MsgBox "数据输入不完整,请将数据输入完整", vbExclamation, "系统提示"
Exit Sub
End If
Next
If TextKF(5).Text <> "" Then
sqlKF = "update into 客户表(姓名,电话,手机,联系地址,备注)"
sqlKF = sqlKF & " values('" & Trim(TextKF(1).Text) & "','" & Trim(TextKF(2).Text) & "','" & Trim(TextKF(3).Text) & "','" & Trim(TextKF(4).Text) & "','" & Trim(TextKF(5).Text) & "')"
Else
sqlKF = "insert into 客户表(姓名,电话,手机,联系地址,备注)"
sqlKF = sqlKF & " values('" & Trim(TextKF(1).Text) & "','" & Trim(TextKF(2).Text) & "','" & Trim(TextKF(3).Text) & "','" & Trim(TextKF(4).Text) & "','nothing')"
End If
ExeSQL (sqlKF)
MsgBox "客户信息输入成功", vbInformation, "系统提示"
'frmkhinfo.Adodckf.Refresh
Call Command8_Click
End Sub
Private Sub cmdClose_Click()
Unload Me
End Sub
Private Sub Command3_Click() '保存客户信息
Dim t As Integer
For t = 0 To 4
If TextKF(t).Text = "" Then
MsgBox "请将信息输入完整,前五项为必填选项", vbExclamation, "输入提示"
Exit Sub
End If
Next
Dim sqlKF As String
Dim rsKF As ADODB.Recordset
'*********判断是否是添加还是修改*********
If khEdit <> 1 Then
'*****判断是否输入备注******
sqlKF = "select * from 客户表 where 用户编号='" & Val(Trim(TextKF(0).Text)) & "'"
Set rsKF = ExeSQL(sqlKF)
If Not rsKF.EOF Then
MsgBox "已经存在编号为" & Trim(TextKF(0).Text) & "的记录,请重新输入", vbYesNo, "系统提示"
rsKF.Close
Set rsKF = Nothing
Exit Sub
End If
If TextKF(5).Text <> "" Then
sqlKF = "insert into 客户表(用户编号,姓名,电话,手机,联系地址,备注) values('"
For t = 0 To 5
If t <> 5 Then
sqlKF = sqlKF & Trim(TextKF(t).Text) & "','"
Else
sqlKF = sqlKF & Trim(TextKF(t).Text) & "')"
End If
Next
Else
sqlKF = "insert into 客户表(用户编号,姓名,电话,手机,联系地址) values('"
For t = 0 To 4
If t <> 4 Then
sqlKF = sqlKF & Trim(TextKF(t).Text) & "','"
Else
sqlKF = sqlKF & Trim(TextKF(t).Text) & "')"
End If
Next
End If
Else
Dim sqlUpData As String
Dim oldKFid As String
oldKFid = Trim(frmkhinfo.msgList.TextMatrix(frmkhinfo.msgList.Row, 1))
sqlDelkf = "delete from 客户表 where 用户编号='" & Trim(frmkhinfo.msgList.TextMatrix(frmkhinfo.msgList.Row, 1)) & "'"
ExeSQL (sqlDelkf) '删除旧记录
sqlKF = "select * from 客户表 where 用户编号='" & Trim(TextKF(0).Text) & "'"
Set rsKF = ExeSQL(sqlKF)
If Not rsKF.EOF Then
MsgBox "已经存在编号为" & Trim(TextKF(0).Text) & "的记录,请重新输入", vbYesNo, "系统提示"
rsKF.Close
Set rsKF = Nothing
Exit Sub
End If
sqlKF = "insert into 客户表 values('"
For t = 0 To 5
If t <> 5 Then
sqlKF = sqlKF & Trim(TextKF(t).Text) & "','"
Else
sqlKF = sqlKF & Trim(TextKF(t).Text) & "')"
End If
Next
'***********更新销售表中用户编号************
If oldKFid <> Trim(TextKF(0).Text) Then
sqlUpData = "update 销售表 set 用户编号='" & Trim(TextKF(0).Text) & "' where 用户编号='" & oldKFid & "'"
ExeSQL (sqlUpData)
End If
'***************模块结束***************
khEdit = 0
End If
ExeSQL (sqlKF)
MsgBox "输入成功,请返回", vbInformation, "系统提示"
frmkhinfo.showdata
Call Command8_Click
End Sub
Private Sub Command8_Click()
For i = 0 To 5
TextKF(i).Text = ""
Next
End Sub
Public Sub showdata(txtsql As String)
On Error GoTo errorhandle
Dim rsshow As ADODB.Recordset
Dim i As Integer
If txtsql = "" Then
txtsql = "select * from 客户表"
End If
Set rsshow = ExeSQL(txtsql)
For i = 0 To rsshow.Fields.Count - 1
TextKF(i) = rsshow.Fields(i)
Next
rsshow.Close
Set rsshow = Nothing
errorhandle:
If Err.Number = 91 Then
Resume Next
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
If khEdit = 1 Then
khEdit = 0
End If
Set frmkh = Nothing
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -