مساعد في ايجاد الخطاء في قاعدة if لنقل البيانات والتحقق من الشروط

[amir_adam83]

السلام عليكم ورحمة الله

اساتذتي  الكرام

لدي جدول به اسماء المنتجات وبه مده المنتج المتفق عليه بمعنى (لدي صنف اسمه معجون طماطم مده صلاحيتة من تاريخ الانتاج لتاريخ الانتهاء وليكن عامين) المده المتفق عليها لاضافته داخل المستودع هي 6اشهر اي 180يوم

عند طلب الصنف للاضافه يتم استدعاء المده المحدد مع كود الصنف واسم الصنف وهي ثابتة .....وعند ادخال تاريخ الانتاج وتاريخ الانتهاء ياتي بمده الصلاحية باليوم ومن ثم من تاريخ الانتهاء الى تاريخ اليوم ياتي بالمده المتبقيه من الصلاحيه للمنتج باليوم وهن يتم المقارنة بين المده المتبقية والمده المحدد اذاكانت المده المتبقية اكبر من المده المحدد يتم ترحيله الى جدو المخازن من خلال تنشيط زر اضافة منتج للمخازن

المشكله ان عندي اذا ظهرت المده بالسالب تتم عملية الاضافه

والمرفق متواجد به كافة الاكواد  ولا اعلم لماذ لا يرحل معي بعد عملية التاكد

وهاهي الاكواد التي تم عملها 

Option Compare Database
Private Sub CmdAdd_Click()
        On Error Resume Next
        DoCmd.SetWarnings False
        DoCmd.RunSQL "INSERT INTO odb_TbleProdWher (odb_ItemCode, odb_ItemNam, odb_DateProdc, odb_DateProdc,odb_DourLI,odb_DouPrd,odb_DourLIPro )" & _
        "SELECT odb_TbleProd.odb_ItemCodex, odb_TbleProd.odb_ItemNamx, odb_TbleProd.odb_DateProdcx, odb_TbleProd.odb_DateProdcx, odb_TbleProd.odb_DourLIx, odb_TbleProd.odb_DouPrdx, odb_TbleProd.odb_DourLIProx" & _
        " FROM odb_TbleProd;"
        DoCmd.SetWarnings True
        MsgBox "تم الحفظ"
        Me.odb_ItemCode = ""
        Me.odb_ItemNam = ""
        Me.odb_DateProdc = ""
        Me.odb_DateProdc = ""
        Me.odb_DourLI = ""
        Me.odb_DouPrd = ""
        Me.odb_DourLIPro = ""
End Sub
Private Sub Form_Load()
        On Error Resume Next
        Me.CmdAdd.Visible = False
        Me.odb_ImageY.Visible = False
        Me.odb_ImageN.Visible = False
End Sub
Private Sub odb_DouPrd_Enter()
        On Error Resume Next
        Me.odb_DouPrd = DateDiff("d", [odb_DateProdc], [odb_DaetExpir])
End Sub
Private Sub odb_DourLIPro_Enter()
        On Error Resume Next
        Me.odb_DourLIPro = DateDiff("d", [odb_DateDayEx], [odb_DaetExpir])
End Sub
Private Sub odb_DourLIPro_Exit(Cancel As Integer)
        On Error Resume Next
If odb_DourLIPro > odb_DourLI Then
        Me.CmdAdd.Visible = True
        Me.odb_ImageN.Visible = True
        Me.odb_ImageY.Visible = False
Else
        MsgBox "عفوا صلاحية المنتج غير مطابقة لمعيار المده المحدد", vbCritical + vbOKOnly, "عمليات الصرف والاضافه"
        Me.odb_ItemCode.SetFocus
        Cancel = -1
        Me.CmdAdd.Visible = False
        Me.odb_ImageN.Visible = False
        Me.odb_ImageY.Visible = False

End If

End Sub
Private Sub odb_ItemCode_DblClick(Cancel As Integer)
        On Error Resume Next
        DoCmd.OpenForm "Frm_Prodaction"
End Sub
Private Sub CmdClose_Click()
        On Error GoTo CmdClose_Click_Err
        DoCmd.Close , ""
CmdClose_Click_Exit:
Exit Sub
CmdClose_Click_Err:
    MsgBox Error$
    Resume CmdClose_Click_Exit
End Sub
Private Sub CmdAddRecord_Click()
        On Error GoTo CmdAddRecord_Click_Err
        On Error Resume Next
        DoCmd.GoToRecord , "", acNewRec
If (MacroError <> 0) Then
        Beep
        MsgBox MacroError.Description, vbOKOnly, ""
End If
CmdAddRecord_Click_Exit:
Exit Sub
CmdAddRecord_Click_Err:
       MsgBox Error$
       Resume CmdAddRecord_Click_Exit
End Sub
Private Sub Command31_Click()
        On Error GoTo Command31_Click_Err
        DoCmd.GoToRecord , "", acFirst
Command31_Click_Exit:
Exit Sub
Command31_Click_Err:
        MsgBox Error$
        Resume Command31_Click_Exit
End Sub
Private Sub Command33_Click()
        On Error GoTo Command33_Click_Err
        DoCmd.GoToRecord , "", acLast
Command33_Click_Exit:
Exit Sub
Command33_Click_Err:
        MsgBox Error$
        Resume Command33_Click_Exit
End Sub
Private Sub Command34_Click()
        On Error GoTo Command34_Click_Err
        On Error Resume Next
        DoCmd.GoToRecord , "", acNext
If (MacroError <> 0) Then
        Beep
        MsgBox MacroError.Description, vbOKOnly, ""
End If
Command34_Click_Exit:
Exit Sub
Command34_Click_Err:
        MsgBox Error$
        Resume Command34_Click_Exit
End Sub
Private Sub Command35_Click()
        On Error GoTo Command35_Click_Err
        On Error Resume Next
        DoCmd.GoToRecord , "", acPrevious
If (MacroError <> 0) Then
        Beep
        MsgBox MacroError.Description, vbOKOnly, ""
End If
Command35_Click_Exit:
Exit Sub
Command35_Click_Err:
        MsgBox Error$
        Resume Command35_Click_Exit
End Sub

برجاء المساعده واين يكمن الخطاء 

شكرا لكم

odbExe.rar

[Eng.Qassim]

اشعر بان هناك خطأ في جملة الالحاق عند الضغط على زر الاضافة ...هذا اولا

وثانيا اين شرط المدة المتبقية قبل الالحاق ؟

[أمير ادم]

30 دقائق مضت, Eng.Qassim said:

اشعر بان هناك خطأ في جملة الالحاق عند الضغط على زر الاضافة ...هذا اولا

وثانيا اين شرط المدة المتبقية قبل الالحاق ؟

شكرا لك على المداخله اخي الكريم تفضل

Private Sub odb_DourLIPro_Exit(Cancel As Integer)
        On Error Resume Next
If odb_DourLIPro > odb_DourLI Then
        Me.CmdAdd.Visible = True
        Me.odb_ImageN.Visible = True
        Me.odb_ImageY.Visible = False
Else
        MsgBox "عفوا صلاحية المنتج غير مطابقة لمعيار المده المحدد", vbCritical + vbOKOnly, "عمليات الصرف والاضافه"
        Me.odb_ItemCode.SetFocus
        Cancel = -1
        Me.CmdAdd.Visible = False
        Me.odb_ImageN.Visible = False
        Me.odb_ImageY.Visible = False

End If

 

[د.كاف يار]

تفضل هذا التعديل

 

odbExe.zip

[أمير ادم]

16 دقائق مضت, د.كاف يار said:

تفضل هذا التعديل

 

odbExe.zip 101.15 kB · 0 downloads

مشاء الله استاذي الكريم بارك الله فيك فعلا هذا هو المطلوب ولكن لماذا عند ادخال تاريخ الانتاج مثال1-1-2021 الانتهاء 31-12-2022 تظهر هذه الرسالة

 

 

اريد ان ادخل تاريخ الانتاج وتاريخ الانتهاء كما هو متواجد على العبوه وهنا لا يقبل 

بارك الله فيك وجزاك الله خير الجزاء

 

[د.كاف يار]

تفضل هذا التعديل

 

odbExe2.zip

[أمير ادم]

7 دقائق مضت, د.كاف يار said:

تفضل هذا التعديل

 

odbExe2.zip 173.13 kB · 0 downloads

لا اعلم كيف ادعو لك لاني لا اجد شيء يكفيك مجهودك غير الله يوفقك ويسرلك كل امورك

الله يجزاك خير الجزاء 

اشكرك