📄 frmprovd.frm
字号:
VERSION 5.00
Begin VB.Form frmYZLProvD
BorderStyle = 1 'Fixed Single
Caption = "供应商详细资料"
ClientHeight = 5565
ClientLeft = 3345
ClientTop = 2055
ClientWidth = 8940
LinkTopic = "Form3"
MaxButton = 0 'False
MDIChild = -1 'True
MinButton = 0 'False
ScaleHeight = 5565
ScaleWidth = 8940
Begin VB.CommandButton cmdBack
Caption = "返回"
Height = 375
Left = 5040
TabIndex = 20
Top = 4680
Width = 1215
End
Begin VB.CommandButton cmdAmend
Caption = "修改"
Height = 375
Left = 3840
TabIndex = 19
Top = 4680
Width = 1215
End
Begin VB.CommandButton cmdDel
Caption = "删除"
Height = 375
Left = 2640
TabIndex = 18
Top = 4680
Width = 1215
End
Begin VB.CommandButton cmdLast
Caption = "最后一条"
Height = 375
Left = 5880
TabIndex = 17
Top = 4080
Width = 1215
End
Begin VB.CommandButton cmdNext
Caption = "下一条"
Height = 375
Left = 4680
TabIndex = 16
Top = 4080
Width = 1215
End
Begin VB.CommandButton CmdPrevious
Caption = "上一条"
Height = 375
Left = 3480
TabIndex = 15
Top = 4080
Width = 1215
End
Begin VB.CommandButton cmdFirst
Caption = "第一条"
Height = 375
Left = 2280
TabIndex = 14
Top = 4080
Width = 1215
End
Begin VB.Frame Frame2
Caption = "联系人资料"
Height = 3255
Left = 4920
TabIndex = 5
Top = 360
Width = 3615
Begin VB.TextBox txtMobile
Enabled = 0 'False
Height = 375
Left = 1560
TabIndex = 13
Top = 2520
Width = 1695
End
Begin VB.TextBox txtOffic
Enabled = 0 'False
Height = 375
Left = 1560
TabIndex = 11
Top = 1800
Width = 1695
End
Begin VB.TextBox txtJob
Enabled = 0 'False
Height = 375
Left = 1560
TabIndex = 9
Top = 1080
Width = 1695
End
Begin VB.TextBox txtName
Enabled = 0 'False
Height = 375
Left = 1560
TabIndex = 7
Top = 360
Width = 1695
End
Begin VB.Label Label6
AutoSize = -1 'True
Caption = "手机:"
Height = 180
Left = 360
TabIndex = 12
Top = 2640
Width = 540
End
Begin VB.Label Label5
AutoSize = -1 'True
Caption = "办公电话:"
Height = 180
Left = 360
TabIndex = 10
Top = 1920
Width = 900
End
Begin VB.Label Label4
AutoSize = -1 'True
Caption = "联系人职位:"
Height = 180
Left = 360
TabIndex = 8
Top = 1200
Width = 1080
End
Begin VB.Label Label3
AutoSize = -1 'True
Caption = "联系人:"
Height = 180
Left = 360
TabIndex = 6
Top = 480
Width = 720
End
End
Begin VB.Frame Frame1
Caption = "供应商资料"
Height = 3255
Left = 360
TabIndex = 0
Top = 360
Width = 4335
Begin VB.TextBox txtEmp
Enabled = 0 'False
Height = 495
Left = 1440
TabIndex = 24
Top = 2520
Width = 2535
End
Begin VB.TextBox txtID
Enabled = 0 'False
Height = 375
Left = 1440
TabIndex = 22
Top = 360
Width = 2535
End
Begin VB.TextBox txtProvDress
Enabled = 0 'False
Height = 735
Left = 1440
MultiLine = -1 'True
TabIndex = 4
Top = 1560
Width = 2535
End
Begin VB.TextBox txtProvName
Enabled = 0 'False
Height = 375
Left = 1440
TabIndex = 2
Top = 960
Width = 2535
End
Begin VB.Label Label8
AutoSize = -1 'True
Caption = "录入采购:"
Height = 180
Left = 240
TabIndex = 23
Top = 2640
Width = 900
End
Begin VB.Label Label7
AutoSize = -1 'True
Caption = "供应商号:"
Height = 180
Left = 240
TabIndex = 21
Top = 480
Width = 900
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "供应商地址:"
Height = 180
Left = 240
TabIndex = 3
Top = 1560
Width = 1080
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "供应商名:"
Height = 180
Left = 240
TabIndex = 1
Top = 1080
Width = 900
End
End
End
Attribute VB_Name = "frmYZLProvD"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub cmdAmend_Click()
If uName <> txtEmp.Text Then
MsgBox "非录入采购不能进行此操作!", vbInformation
Exit Sub
End If
frmYZLXPro.Show
End Sub
Private Sub cmdBack_Click()
If Pstate = True Then Pstate = False
Unload Me
End Sub
Private Sub cmdDel_Click()
Dim strsql As String
If Pstate = True Then '窗体为添加新供应商
If txtProvName.Text = "" Then
MsgBox "供应商名不能为空", vbInformation
txtProvName.SetFocus
Exit Sub
End If
If txtProvDress.Text = "" Then
MsgBox "供应商地址不能为空", vbInformation
txtProvDress.SetFocus
Exit Sub
End If
If txtName.Text = "" Then
MsgBox "联系人名不能为空", vbInformation
txtName.SetFocus
Exit Sub
End If
If txtJob.Text = "" Then
MsgBox "联系职务不能为空", vbInformation
txtJob.SetFocus
Exit Sub
End If
If txtOffic.Text = "" Then
MsgBox "联系人办公电话不能为空", vbInformation
txtOffic.SetFocus
Exit Sub
End If
If txtMobile.Text = "" Then
MsgBox "联系人手机不能为空", vbInformation
txtMobile.SetFocus
Exit Sub
End If
If Pstate = True Then '当为添加按钮时
strsql = "insert into t_provider values('" & Trim(txtId.Text) & "','" & Trim(txtProvName.Text) & "','" & Trim(txtName.Text) & "','" & Trim(txtJob.Text) & "','" & Trim(txtMobile.Text) & "','" & Trim(txtOffic.Text) & "','" & Trim(txtProvDress.Text) & "','" & Trim(txtEmp.Text) & "')"
Dblink.executeSQL (strsql)
Call YZLRefMSHFlexGrid(frmYZLProv, "select providerid '供应商号',providername '供应商名' from t_provider")
Unload Me
End If
Else '窗体为删除供应商
If uName <> txtEmp.Text Then
MsgBox "非录入采购不能进行此操作!", vbInformation
Exit Sub
End If
Dim resPonse
resPonse = MsgBox("确定删除供应商‘" & Trim(txtProvName.Text) & "’?", vbOKCancel + vbQuestion, "删除供应商")
If resPonse = 1 Then '确定删除
strsql = "delete t_provider where providerid='" & Trim(txtId.Text) & "'"
On Error Resume Next
Dblink.executeSQL (strsql)
If Err.Number = -2147217873 Then
MsgBox "该供应商与本超市已有业务往来,此操作禁止!", vbInformation
Exit Sub
End If
Call YZLRefMSHFlexGrid(frmYZLProv, "select providerid '供应商号',providername '供应商名' from t_provider")
Unload Me
End If
End If
End Sub
Private Sub cmdFirst_Click()
Dblink.rs.MoveFirst
End Sub
Private Sub cmdLast_Click()
Dblink.rs.MoveLast
End Sub
Private Sub cmdNext_Click()
Dblink.rs.MoveNext
If Dblink.rs.EOF = True Then
MsgBox "已到记录最后一条!", vbInformation
Dblink.rs.MoveLast
End If
End Sub
Private Sub CmdPrevious_Click()
Dblink.rs.MovePrevious
If Dblink.rs.BOF = True Then
MsgBox "已到记录第一条!", vbInformation
Dblink.rs.MoveFirst
End If
End Sub
Private Sub Form_Load()
txtEmp.Enabled = False
If Pstate = True Then '窗体为添加新供应商
Me.Caption = "添加新供应商"
cmdFirst.Visible = False
CmdPrevious.Visible = False
cmdNext.Visible = False
cmdLast.Visible = False
cmdAmend.Visible = False
cmdDel.Caption = "添加"
txtEmp.Text = uName
txtProvName.Enabled = True
txtProvDress.Enabled = True
txtName.Enabled = True
txtJob.Enabled = True
txtOffic.Enabled = True
txtMobile.Enabled = True
cmdDel.Top = cmdDel.Top - 400
cmdBack.Top = cmdBack.Top - 400
txtId.Text = newid("t_provider", "providerid") '调用存储过程,自动生成临时新的供应商号
Else '窗体为查看或修改供应商
Dim strsql As String
strsql = "select providerid,providername,provideradress,linkman,job,mobile,offictel,employeeid from t_provider"
Dblink.executeSQL (strsql)
Do While Not Dblink.rs.EOF
If Dblink.rs.Fields(0).Value = frmYZLProv.MSHFlexGrid1.Tag Then
txtId.DataField = Dblink.rs.Fields(0).name
Set txtId.DataSource = Dblink.rs
txtProvName.DataField = Dblink.rs.Fields(1).name
Set txtProvName.DataSource = Dblink.rs
txtProvDress.DataField = Dblink.rs.Fields(2).name
Set txtProvDress.DataSource = Dblink.rs
txtName.DataField = Dblink.rs.Fields(3).name
Set txtName.DataSource = Dblink.rs
txtJob.DataField = Dblink.rs.Fields(4).name
Set txtJob.DataSource = Dblink.rs
txtMobile.DataField = Dblink.rs.Fields(5).name
Set txtMobile.DataSource = Dblink.rs
txtOffic.DataField = Dblink.rs.Fields(6).name
Set txtOffic.DataSource = Dblink.rs
txtEmp.DataField = Dblink.rs.Fields(7).name
Set txtEmp.DataSource = Dblink.rs
Exit Do
End If
Dblink.rs.MoveNext
Loop
End If
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Call cmdBack_Click
End Sub
Private Sub txtJob_KeyPress(KeyAscii As Integer)
KeyAscii = YZLKpress(KeyAscii)
End Sub
Private Sub txtJob_LostFocus()
If Len(Trim(txtJob.Text)) > 10 Then
MsgBox "联系人职位不能超过10个字符", vbInformation
txtJob.SetFocus
End If
End Sub
Private Sub txtMobile_KeyPress(KeyAscii As Integer)
If ((KeyAscii > 47 And KeyAscii < 58) Or KeyAscii = 8) Then
Exit Sub
Else
KeyAscii = 0
End If
End Sub
Private Sub txtMobile_LostFocus()
If Len(Trim(txtMobile.Text)) > 15 Then
MsgBox "联系人移动电话不能超过15个字符", vbInformation
txtMobile.SetFocus
End If
End Sub
Private Sub txtName_KeyPress(KeyAscii As Integer)
KeyAscii = YZLKpress(KeyAscii)
End Sub
Private Sub txtName_LostFocus()
If Len(Trim(txtName.Text)) > 10 Then
MsgBox "联系人名不能超过10个字符", vbInformation
txtName.SetFocus
End If
End Sub
Private Sub txtOffic_KeyPress(KeyAscii As Integer)
If ((KeyAscii > 47 And KeyAscii < 58) Or KeyAscii = 8) Then
Exit Sub
Else
KeyAscii = 0
End If
End Sub
Private Sub txtOffic_LostFocus()
If Len(Trim(txtOffic.Text)) > 15 Then
MsgBox "办公室电话不能超过15个字符", vbInformation
txtOffic.SetFocus
End If
End Sub
Private Sub txtProvDress_KeyPress(KeyAscii As Integer)
KeyAscii = YZLKpress(KeyAscii)
End Sub
Private Sub txtProvDress_LostFocus()
If Len(Trim(txtProvDress.Text)) > 100 Then
MsgBox "供应商地址不能超过100个字符", vbInformation
txtProvDress.SetFocus
End If
End Sub
Private Sub txtProvName_KeyPress(KeyAscii As Integer)
KeyAscii = YZLKpress(KeyAscii)
End Sub
Private Sub txtProvName_LostFocus()
If Len(Trim(txtProvName.Text)) > 10 Then
MsgBox "供应商名不能超过10个字符", vbInformation
txtProvName.SetFocus
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -