📄 frmserverinput.frm
字号:
VERSION 5.00
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Begin VB.Form frmServerInput
Caption = "问题信息录入单"
ClientHeight = 6255
ClientLeft = 60
ClientTop = 345
ClientWidth = 7215
LinkTopic = "Form4"
LockControls = -1 'True
ScaleHeight = 6255
ScaleWidth = 7215
StartUpPosition = 2 '屏幕中心
Begin VB.CommandButton Command2
Caption = "取消"
Height = 495
Left = 4440
TabIndex = 8
Top = 5520
Width = 1215
End
Begin VB.CommandButton Command1
Caption = "确定"
Default = -1 'True
Height = 495
Left = 1560
TabIndex = 7
Top = 5520
Width = 1215
End
Begin MSComCtl2.DTPicker DT_QuestDate
Height = 330
Left = 1680
TabIndex = 1
Top = 795
Width = 1575
_ExtentX = 2778
_ExtentY = 582
_Version = 393216
Format = 26935296
CurrentDate = 38015
End
Begin VB.TextBox txtSolution
Height = 1170
Left = 480
TabIndex = 6
Top = 4080
Width = 6255
End
Begin VB.TextBox txtViaperson
Height = 330
Left = 1680
TabIndex = 2
Top = 1275
Width = 1575
End
Begin VB.TextBox txtDescription
Height = 1170
Left = 480
TabIndex = 5
Top = 2280
Width = 6255
End
Begin VB.TextBox txtQuestID
Height = 330
Left = 1680
TabIndex = 0
Top = 322
Width = 1575
End
Begin VB.Frame Frame1
Caption = "问题提交者"
Height = 1455
Left = 3600
TabIndex = 14
Top = 240
Width = 3135
Begin VB.TextBox Text1
BackColor = &H80000013&
Enabled = 0 'False
Height = 330
Left = 1320
TabIndex = 16
Top = 360
Width = 1575
End
Begin VB.OptionButton Option1
Caption = "供应商 S"
Height = 255
Left = 240
TabIndex = 3
Top = 398
Value = -1 'True
Width = 1095
End
Begin VB.TextBox Text2
BackColor = &H80000013&
Enabled = 0 'False
Height = 330
Left = 1320
TabIndex = 15
Top = 840
Width = 1575
End
Begin VB.OptionButton Option2
Caption = "客户 C"
Height = 255
Left = 240
TabIndex = 4
Top = 878
Width = 1095
End
End
Begin VB.Label Label5
Alignment = 1 'Right Justify
Caption = "解决方案描述（可预留空）"
Height = 255
Left = 360
TabIndex = 13
Top = 3840
Width = 2295
End
Begin VB.Label Label4
Alignment = 1 'Right Justify
Caption = "问题（现状）描述"
Height = 255
Left = 360
TabIndex = 12
Top = 2040
Width = 1575
End
Begin VB.Label Label3
Alignment = 1 'Right Justify
Caption = "经办人"
Height = 255
Left = 840
TabIndex = 11
Top = 1320
Width = 735
End
Begin VB.Label Label2
Alignment = 1 'Right Justify
Caption = "问题提交时间"
Height = 255
Left = 360
TabIndex = 10
Top = 840
Width = 1215
End
Begin VB.Label Label1
Alignment = 1 'Right Justify
Caption = "问题信息单号"
Height = 255
Left = 360
TabIndex = 9
Top = 360
Width = 1215
End
End
Attribute VB_Name = "frmServerInput"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub Command1_Click()
Dim Rst As New ADODB.Recordset
Dim strSQL As String
On Error GoTo ErrorExit
If Me.txtQuestID = "" Then '判断问题信息单号不为空
MsgBox "问题信息单号不能为空！"
Me.txtQuestID.SetFocus
Exit Sub
End If
If IsNumeric(Me.txtQuestID) = False Then '判断单号为数字
MsgBox "问题信息单号必须为数字！"
Me.txtQuestID = ""
Me.txtQuestID.SetFocus
Exit Sub
End If
If Len(Me.txtQuestID) <> 8 Then '判断单号位数为8
MsgBox "问题信息单号必须8位！"
Me.txtQuestID = ""
Me.txtQuestID.SetFocus
Exit Sub
End If
If Me.txtViaperson = "" Then '判断经办人不留空
MsgBox "经办人栏不得留空！"
Me.txtViaperson.SetFocus
Exit Sub
End If
If Me.txtDescription = "" Then '判断问题描述不留空
MsgBox "请填写问题描述。"
Me.txtDescription.SetFocus
Exit Sub
End If
If Me.Option1.Value = True Then '如果当前问题提交者是供应商
strSQL = "select * from tb_Supplier where SuppID = 'S" & Me.Text1 & "'"
Rst.Open strSQL, CnnDatabase, adOpenStatic
If Rst.RecordCount > 1 Then '供应商代码不唯一
MsgBox "此供应商代码在供应商信息数据表中不唯一！", vbCritical, "数据库错误！"
Rst.Close
Exit Sub
End If
If Rst.RecordCount = 0 Then '供应商代码不存在
MsgBox "无此供应商代码！", vbCritical, "供应商代码错误"
Rst.Close
Exit Sub
End If
Rst.Close
Else '当前问题提交者是客户
strSQL = "select * from tb_Customer where CustID = 'C" & Me.Text2 & "'"
Rst.Open strSQL, CnnDatabase, adOpenStatic
If Rst.RecordCount > 1 Then '客户代码不唯一
MsgBox "此客户代码在客户信息数据表中不唯一！", vbCritical, "数据库错误！"
Rst.Close
Exit Sub
End If
If Rst.RecordCount = 0 Then '客户代码不存在
MsgBox "无此客户代码！", vbCritical, "客户代码错误"
Rst.Close
Exit Sub
End If
Rst.Close
End If
strSQL = "tb_Quest"
Rst.Open strSQL, CnnDatabase, adOpenDynamic, adLockOptimistic
Rst.AddNew '开始添加新记录
Rst!QuestID = Me.txtQuestID
Rst!questdate = Me.DT_QuestDate
Rst!Viaperson = Me.txtViaperson
If Me.Option1.Value = True Then '当前问题提交者是供应商
Rst!questperson = "S" & Me.Text1
Else '当前问题提交者是客户
Rst!questperson = "C" & Me.Text2
End If
Rst!Description = Me.txtDescription
Rst!solution = Me.txtSolution
Rst.Update '新记录添加结束
MsgBox "新问题记录提交成功！", vbInformation, "信息添加完成-"
Initial_Add '重新初始化界面
Exit Sub
ErrorExit:
MsgBox Err.Description, vbCritical, Me.Caption
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
Private Sub Initial_Add()
Me.txtQuestID = "" '清空界面
Me.txtViaperson = ""
Me.txtDescription = ""
Me.txtSolution = ""
Me.DT_QuestDate.Value = Date '初始今天日期
Me.Option1.Value = True '供应商的单选可用
Me.Option2.Value = False
Me.Text1.Enabled = True '供应商代码栏可用
Me.Text2.Enabled = False
Me.Text1.BackColor = &H80000005 '供应商代码栏背景为白色
Me.Text2.BackColor = &H80000013 '客户代码栏为灰色
Me.Text1 = ""
Me.Text2 = ""
End Sub
Private Sub Form_Load()
Initial_Add
End Sub
Private Sub Option1_Click()
Me.Text1.Enabled = True '供应商代码栏可用
Me.Text2.Enabled = False
Me.Text1.BackColor = &H80000005 '供应商代码栏背景为白色
Me.Text2.BackColor = &H80000013 '客户代码栏为灰色
Me.Text1 = ""
Me.Text2 = ""
End Sub
Private Sub Option2_Click()
Me.Text1.Enabled = False '供应商代码栏不可用
Me.Text2.Enabled = True '客户代码栏可用
Me.Text1.BackColor = &H80000013 '供应商代码栏背景为灰色
Me.Text2.BackColor = &H80000005 '客户代码栏背景为白色
Me.Text1 = ""
Me.Text2 = ""
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -