|
新手一枚,请教高手了!
我做了项目合同信息录入VBA,其他数据均可正常录入ACCESS,只有如图的横向三组数据无法录入,提示出错!请高手指点!
代码如下
Private Sub CommandButton1_Click()
On Error GoTo 100
'=====判断输入数据规范性====
If TextBox1.Text = "" Or TextBox2.Text = "" Or TextBox3.Text = "" Or ComboBox1.Text = "" Or ComboBox2.Text = "" Or ComboBox7.Text = "" Or ComboBox6.Text = "" Or ComboBox8.Text = "" Or ComboBox9.Text = "" Or ComboBox3.Text = "" Then
MsgBox "必填信息是必须输入的", 1 + 16, "出错提示"
TextBox1.SetFocus
Exit Sub
End If
'==============查找是否已经有相同工号记录=====================
Dim RS1 As Recordset
Dim DB1 As Database
Set DB1 = OpenDatabase(ThisWorkbook.Path & "\" & "Info.MDB")
Set RS1 = DB1.OpenRecordset(Name:="承包合同信息", Type:=dbOpenDynaset)
With RS1
.FindFirst "合同编号='" & TextBox1.Value & "'"
If Not .NoMatch Then
MsgBox "合同编号 [ " & TextBox1.Value & " ] 的信息已存在,不能重复添加!", 1 + 16, "出错提示"
DB1.Close
Set RS1 = Nothing
Set DB1 = Nothing
Exit Sub
Else
'=============如果未找到工号重复的情况,则新加记录
.AddNew
'必填信息输入
.Fields("合同编号").Value = Me.TextBox1.Value
.Fields("负责部门").Value = Me.ComboBox1.Value
.Fields("项目经理").Value = Me.ComboBox2.Value
.Fields("区域").Value = Me.ComboBox6.Value
.Fields("合同总价").Value = Me.TextBox3.Value
.Fields("项目名称").Value = Me.TextBox2.Value
.Fields("签订年").Value = Me.ComboBox8.Value
.Fields("月").Value = Me.ComboBox9.Value
.Fields("日").Value = Me.ComboBox3.Value
.Fields("合同性质").Value = Me.ComboBox7.Value
'辅助信息输入
.Fields("工程类别").Value = Me.ComboBox10.Value
.Fields("批注").Value = Me.TextBox11.Value
.Fields("分类").Value = Me.TextBox8.Value
.Fields("甲方").Value = Me.TextBox7.Value
.Fields("图纸资料发放").Value = Me.ComboBox11.Value
.Fields("含设备").Value = Me.ComboBox12.Value
' .Fields("工程账号").Value = Me.TextBox9.Value
' .Fields("签订状态").Value = Me.ComboBox14.Value
' .Fields("签订形式").Value = Me.ComboBox13.Value
.Fields("开票状态").Value = Me.ComboBox15.Value
.Fields("开票金额").Value = Me.TextBox10.Value
.Fields("计数").Value = Me.ComboBox57.Value
.Fields("收款金额").Value = Me.TextBox33.Value
.Update
MsgBox "增加 [ 合同编号:" & TextBox1.Value & " 项目经理:" & ComboBox2.Value & " ] 的信息成功!目前共有记录" & RS1.RecordCount & "条", 1 + 16, "添加成功"
End If
End With
'=================添加记录结束============================
DB1.Close
Set RS1 = Nothing
Set DB1 = Nothing
Exit Sub '正常执行结束,跳出 sub
100:
MsgBox "程序执行出错", 1 + 16, "系统提示"
End Sub
Private Sub CommandButton2_Click()
Unload Me
End Sub
|
|