com12151337
شنبه 07 دی 1392, 17:13 عصر
سلام دوستان از این کد که دوستان زحمت کشیدن در برنامه انبار دار ی استفاده میکنم در این کد اگر شرح مشخصات 2 بار تکرار شود اعلام میکند که قبلا" استفاده شده حالا میخواهم تا 8 با ر اجازه ثبت بدم به چه شکل میتوان آن را اصلاح کرد ممنون
Private Sub btn_submitkala_Click()
On Error GoTo Err_han
Dim no9 As String
Dim numCount As Integer
numCount = DCount("name", "kalaha", "name='" & Me.cmb_kala.Value & "'")
If IsNull(cmb_kala) Then
cmb_kala.BackColor = 10544373
cmb_kala.SetFocus
Exit Sub
ElseIf numCount > 0 Then
cmb_kala.BackColor = 10544373
MsgBoxFa Space(20) & " شرح مشخصات کالا ( " & Me.cmb_kala.Value & " ) قبلاً ثبت شده است، ثبت مجدد آن امکانپــــذير نمي باشد" & Space(28), vbExclamation, "خطا"
cmb_kala.Undo
cmb_kala.SetFocus
End If
Exit Sub
ElseIf IsNull(cmb_daste) Then
cmb_kala.BackColor = 15398129
cmb_daste.BackColor = 10544373
cmb_daste.SetFocus
Exit Sub
ElseIf IsNull(cmb_vahed) Then
cmb_kala.BackColor = 15398129
cmb_daste.BackColor = 16777215
cmb_vahed.BackColor = 10544373
cmb_vahed.SetFocus
Else
cmb_kala.BackColor = 15398129
cmb_daste.BackColor = 16777215
cmb_vahed.BackColor = 14286332
'----------------------------------------
'----
Select Case cmb_vahed.Column(1)
Case Is <> 0
If txt_vazn.Value < 0 Or IsNull(Trim(txt_vazn.Value)) Then
txt_vazn.SetFocus
Exit Sub
End If
End Select
'------'
'saving'
'------'
Dim db As Database
Dim rst As Recordset
Set db = CurrentDb
Set rst = db.OpenRecordset("kalaha")
rst.AddNew
'saving to fileds
rst.Fields("id_daste") = id.Value
rst.Fields("name") = cmb_kala.Value
rst.Fields("name_daste") = cmb_daste.Value
rst.Fields("noe_kala") = cmb_vahed.Value
If IsNull(Trim(txt_defmujoodi.Value)) Then
txt_defmujoodi.Value = 0
End If
rst.Fields("mojoodi") = txt_defmujoodi.Value
rst.Fields("Def_vazn") = txt_vazn.Value
rst.Update
rst.Close
list_kala.Requery
id.Value = Null
cmb_daste.Value = Null
cmb_kala.Value = Null
cmb_vahed.Value = Null
txt_defmujoodi.Value = 0
txt_vazn.Value = 0
cmb_kala.SetFocus
End If
Exit Sub
Err_han:
MsgBoxFa "خطايي در ثبت رخ داده است لطفاً موارد را يک بار ديگر بررسي نماييد.", vbExclamation, "خطا در ثبت"
End Sub
Private Sub btn_submitkala_Click()
On Error GoTo Err_han
Dim no9 As String
Dim numCount As Integer
numCount = DCount("name", "kalaha", "name='" & Me.cmb_kala.Value & "'")
If IsNull(cmb_kala) Then
cmb_kala.BackColor = 10544373
cmb_kala.SetFocus
Exit Sub
ElseIf numCount > 0 Then
cmb_kala.BackColor = 10544373
MsgBoxFa Space(20) & " شرح مشخصات کالا ( " & Me.cmb_kala.Value & " ) قبلاً ثبت شده است، ثبت مجدد آن امکانپــــذير نمي باشد" & Space(28), vbExclamation, "خطا"
cmb_kala.Undo
cmb_kala.SetFocus
End If
Exit Sub
ElseIf IsNull(cmb_daste) Then
cmb_kala.BackColor = 15398129
cmb_daste.BackColor = 10544373
cmb_daste.SetFocus
Exit Sub
ElseIf IsNull(cmb_vahed) Then
cmb_kala.BackColor = 15398129
cmb_daste.BackColor = 16777215
cmb_vahed.BackColor = 10544373
cmb_vahed.SetFocus
Else
cmb_kala.BackColor = 15398129
cmb_daste.BackColor = 16777215
cmb_vahed.BackColor = 14286332
'----------------------------------------
'----
Select Case cmb_vahed.Column(1)
Case Is <> 0
If txt_vazn.Value < 0 Or IsNull(Trim(txt_vazn.Value)) Then
txt_vazn.SetFocus
Exit Sub
End If
End Select
'------'
'saving'
'------'
Dim db As Database
Dim rst As Recordset
Set db = CurrentDb
Set rst = db.OpenRecordset("kalaha")
rst.AddNew
'saving to fileds
rst.Fields("id_daste") = id.Value
rst.Fields("name") = cmb_kala.Value
rst.Fields("name_daste") = cmb_daste.Value
rst.Fields("noe_kala") = cmb_vahed.Value
If IsNull(Trim(txt_defmujoodi.Value)) Then
txt_defmujoodi.Value = 0
End If
rst.Fields("mojoodi") = txt_defmujoodi.Value
rst.Fields("Def_vazn") = txt_vazn.Value
rst.Update
rst.Close
list_kala.Requery
id.Value = Null
cmb_daste.Value = Null
cmb_kala.Value = Null
cmb_vahed.Value = Null
txt_defmujoodi.Value = 0
txt_vazn.Value = 0
cmb_kala.SetFocus
End If
Exit Sub
Err_han:
MsgBoxFa "خطايي در ثبت رخ داده است لطفاً موارد را يک بار ديگر بررسي نماييد.", vbExclamation, "خطا در ثبت"
End Sub