📄 合同信息录入.frm
字号:
Begin VB.Label Label13
Caption = "备 注："
Height = 375
Left = 840
TabIndex = 12
Top = 4200
Width = 1335
End
Begin VB.Label Label12
Caption = "合同金额："
Height = 375
Left = 5520
TabIndex = 11
Top = 3060
Width = 1335
End
Begin VB.Label Label11
Caption = "企业类别："
Height = 375
Left = 840
TabIndex = 10
Top = 3015
Width = 1335
End
Begin VB.Label Label10
Caption = "认证机构："
Height = 375
Left = 5520
TabIndex = 9
Top = 2523
Width = 1335
End
Begin VB.Label Label9
Caption = "发证日期："
Height = 375
Left = 840
TabIndex = 8
Top = 2490
Width = 1335
End
Begin VB.Label Label8
Caption = "启动日期："
Height = 375
Left = 5520
TabIndex = 7
Top = 1986
Width = 1335
End
Begin VB.Label Label1
Caption = "合同编号："
Height = 375
Left = 840
TabIndex = 6
Top = 360
Width = 1335
End
Begin VB.Label Label2
Caption = "单位名称："
Height = 375
Left = 5520
TabIndex = 5
Top = 375
Width = 1335
End
Begin VB.Label Label3
Caption = "体 系："
Height = 375
Left = 840
TabIndex = 4
Top = 885
Width = 1335
End
Begin VB.Label Label4
Caption = "部门责任人："
Height = 375
Left = 5520
TabIndex = 3
Top = 912
Width = 1455
End
Begin VB.Label Label5
Caption = "签 约 人："
Height = 375
Left = 840
TabIndex = 2
Top = 1425
Width = 1335
End
Begin VB.Label Label6
Caption = "咨 询 师："
Height = 375
Left = 5520
TabIndex = 1
Top = 1449
Width = 1335
End
Begin VB.Label Label7
Caption = "签订日期："
Height = 375
Left = 840
TabIndex = 0
Top = 1950
Width = 1335
End
End
Attribute VB_Name = "合同信息录入"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim htdb As Database
Dim htrs As Recordset
Dim txrs As Recordset
Dim txad As ADODB.Connection
Dim jgdb, xxk, dqy As ADODB.Connection
Dim txar, xxr, rqy As ADODB.Recordset
Dim jgrs As ADODB.Recordset
'Dim lj As String
Dim strsql As String
Private Sub Command1_Click()
体系录入.Show
End Sub
Private Sub Command2_Click()
签约人录入.Show
End Sub
Private Sub Command3_Click()
'On Error GoTo bb
If Trim(Text1.Text) = "" Or Trim(Text2.Text) = "" Or Trim(DBCombo3.Text) = "" Or Trim(DBCombo4.Text) = "" Or Trim(DBCombo5.Text) = "" Then
MsgBox "录入的项目不能为空,请检查!!", vbOKOnly, "提示信息!!"
Else
If Trim(DBCombo3.Text) = "" Or Trim(Text10.Text) = "" Or Trim(Text11.Text) = "" Then
MsgBox "录入的项目不能为空,请检查!!", vbOKOnly, "提示信息!!"
Else
If DBCombo1.Text = "" Or DBCombo2.Text = "" Then
MsgBox "录入的项目不能为空,请检查!!", vbOKOnly, "提示信息!!"
Else
aa = MsgBox("你输入的数据正确吗?, 真的要保存数据吗?", vbYesNo, "保存按是, 否则按否!")
If aa = 6 Then
htrs.AddNew
htrs!编号 = Trim(Text1.Text)
htrs!单位名称 = Trim(Text2.Text)
htrs!体系 = Trim(DBCombo1.Text)
htrs!部门责任人 = Trim(DBCombo4.Text)
htrs!签约人 = Trim(DBCombo3.Text)
htrs!咨询师 = Trim(DBCombo5.Text)
htrs!签订日期 = CStr(Format(DTP1.Value, "yy-mm-dd"))
htrs!启动日期 = CStr(Format(DTP2.Value, "yy-mm-dd"))
htrs!发证日期 = CStr(Format(DTP3.Value, "yy-mm-dd"))
htrs!认证机构 = Trim(DBCombo2.Text)
htrs!认证性质 = Trim(DBCombo6.Text)
htrs!合同金额 = Trim(Text10.Text)
htrs!认证费 = Trim(Text11.Text)
htrs!咨询费 = Trim(Text6.Text)
htrs!备注 = Trim(Text7.Text)
htrs.Update
Text1.Text = ""
Text2.Text = ""
DBCombo1.Text = ""
DBCombo4.Text = ""
DBCombo3.Text = ""
DBCombo5.Text = ""
Text6.Text = ""
Text7.Text = ""
DBCombo2.Text = ""
DBCombo6.Text = ""
Text10.Text = ""
Text11.Text = ""
GoTo cc
Else
GoTo cc
End If
End If
End If
End If
GoTo cc
bb:
MsgBox "录入的项目不能为空,请检查!!", vbOKOnly, "提示信息!!"
cc:
End Sub
Private Sub Command4_Click()
On Error GoTo bb
jgrs.ActiveConnection = Nothing
jgdb.Close
txar.ActiveConnection = Nothing
txad.Close
bb:
htrs.Close
htdb.Close
Data1.Database.Close
Data2.Database.Close
Unload Me
End Sub
Private Sub Command5_Click()
企业类别录入.Show
End Sub
Private Sub Command6_Click()
责任人录入.Show
End Sub
Private Sub Command7_Click()
咨询师录入.Show
End Sub
Private Sub Command8_Click()
认证机构录入.Show
End Sub
Private Sub DBCombo1_Change()
Data1.RecordSource = "select * from 体系 where 体系 like '*" & Trim(DBCombo1.Text) & "*'"
Data1.Refresh
End Sub
Private Sub DBCombo1_Click(Area As Integer)
Data1.RecordSource = "select * from 体系 where 体系 like '*" & Trim(DBCombo1.Text) & "*'"
Data1.Refresh
DBCombo1.Refresh
DBCombo1.ListField = "体系"
DBCombo1.ReFill
End Sub
Private Sub DBCombo2_Change()
Data2.RecordSource = "select * from 认证机构 where 认证机构 like '*" & DBCombo2.Text & "*'"
Data2.Refresh
End Sub
Private Sub DBCombo2_Click(Area As Integer)
Data2.RecordSource = "select * from 认证机构 where 认证机构 like '*" & DBCombo2.Text & "*'"
Data2.Refresh
DBCombo2.Refresh
DBCombo2.ListField = "认证机构"
DBCombo2.ReFill
End Sub
Private Sub DBCombo3_Change()
Data3.RecordSource = "select * from 签约人 where 签约人 like '*" & DBCombo3.Text & "*'"
Data3.Refresh
End Sub
Private Sub DBCombo3_Click(Area As Integer)
Data3.RecordSource = "select * from 签约人 where 签约人 like '*" & DBCombo3.Text & "*'"
Data3.Refresh
DBCombo3.Refresh
DBCombo3.ListField = "签约人"
DBCombo3.ReFill
End Sub
Private Sub DBCombo4_Click(Area As Integer)
Data4.RecordSource = "select * from 责任人 where 责任人 like '*" & DBCombo4.Text & "*'"
Data4.Refresh
DBCombo4.Refresh
DBCombo4.ListField = "责任人"
DBCombo4.ReFill
End Sub
Private Sub DBCombo4_Change()
Data4.RecordSource = "select * from 责任人 where 责任人 like '*" & DBCombo4.Text & "*'"
Data4.Refresh
End Sub
Private Sub DBCombo5_Click(Area As Integer)
Data5.RecordSource = "select * from 咨询师 where 咨询师 like '*" & DBCombo5.Text & "*'"
Data5.Refresh
DBCombo5.Refresh
DBCombo5.ListField = "咨询师"
DBCombo5.ReFill
End Sub
Private Sub DBCombo5_Change()
Data5.RecordSource = "select * from 咨询师 where 咨询师 like '*" & DBCombo5.Text & "*'"
Data5.Refresh
End Sub
Private Sub DBCombo6_Change()
Data6.RecordSource = "select * from 企业类别 where 类别 like '*" & DBCombo6.Text & "*'"
Data6.Refresh
End Sub
Private Sub DBCombo6_Click(Area As Integer)
Data6.RecordSource = "select * from 企业类别 where 类别 like '*" & DBCombo6.Text & "*'"
Data6.Refresh
DBCombo6.Refresh
DBCombo6.ListField = "类别"
DBCombo6.ReFill
End Sub
Private Sub Form_Load()
'dblj = App.Path + "\data\htxxk.mdb"
Set htdb = OpenDatabase(dblj)
Set htrs = htdb.OpenRecordset("合同信息表")
Data1.DatabaseName = dblj
Data1.RecordSource = "体系"
Data2.DatabaseName = dblj
Data2.RecordSource = "认证机构"
Data3.DatabaseName = dblj
Data3.RecordSource = "签约人"
Data4.DatabaseName = dblj
Data4.RecordSource = "责任人"
Data5.DatabaseName = dblj
Data5.RecordSource = "咨询师"
Data6.DatabaseName = dblj
Data6.RecordSource = "企业类别"
DTP1.Value = Date
DTP2.Value = Date
DTP3.Value = Date
End Sub
Private Sub Text1_Validate(Cancel As Boolean)
Set xxk = New ADODB.Connection
xxk.CursorLocation = adUseClient
xxk.Open "Provider=Microsoft.Jet.OLEDB.3.51;Data Source=" & dblj & ";Persist Security Info=False"
Set xxr = New ADODB.Recordset
xxr.Open "select * from 合同信息表 where 编号 = '" & Trim(Text1.Text) & "'", xxk, adOpenKeyset, adLockOptimistic
If xxr.RecordCount <> 0 Then
MsgBox "合同编号重复,请检查!!", vbOKOnly, "提示信息!!"
xxr.ActiveConnection = Nothing
xxk.Close
Text1.SetFocus
Else
xxr.ActiveConnection = Nothing
xxk.Close
Exit Sub
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -