PDA

View Full Version : کمک جهت اصلاح کد



com12151337
شنبه 07 دی 1392, 16: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

alirezabahrami
شنبه 07 دی 1392, 18:01 عصر
سلام
عملاً تست نکردم ولی فکر کنم در خط دهم اگر بجای ElseIf numCount > 0 Then کد ElseIf numCount > 8 Then را جایگزین کنید خواسته ات محقق میشود.
یا علی

com12151337
شنبه 07 دی 1392, 18:15 عصر
جناب بهرامی عزیز سلام وقت بخیر
تغییر دادم ارور میگره
MsgBoxFa "خطايي در ثبت رخ داده است لطفاً موارد را يک بار ديگر بررسي نماييد.", vbExclamation, "خطا در ثبت"

ممنون

alirezabahrami
شنبه 07 دی 1392, 19:20 عصر
[
جناب بهرامی عزیز سلام وقت بخیر
تغییر دادم ارور میگره
MsgBoxFa "خطايي در ثبت رخ داده است لطفاً موارد را يک بار ديگر بررسي نماييد.", vbExclamation, "خطا در ثبت"

ممنون
با سلام مجدد
آقای محمودی عزیز ! در جدول مربوطه (kalaha) فیلد name بصورت No Duplicates تعریف شده است . شما باید خصوصیت Endexed فیلد name را از حالت No Duplicates خارج کنید و آن را در حالت Duplicates Ok یا No قرار بدهید .
البته وقتی جدول حاوی اطلاعات است اینکار را نمیتوانید انجام بدهید . پیشنهاد میکنم ابتدا از جدول فوق یک کپی تهیه کن و بعد کل اطلاعات جدول kalaha را حذف و خصوصیت فوق را تغییر بده و سپس اطلاعات جدول کپی شده را در جدول فوق وارد کن ( از طریق Append Query )
یا علی