اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

طريقة اضافه سجل باستخدام حقل غير منضم

safaa salem5

بواسطه safaa salem5
في قسم الأكسيس Access

 مشاركة
إذهب إلى أفضل إجابة Solved by M.Abd Allah,

الردود الموصى بها

safaa salem5

safaa salem5

قام بنشر
قام بنشر (معدل)

عندى فورم مصدره جدول  اسمه

Fixed_tbl

فيه حقل منضم اسمه

Fixedname

وعندى حقل غير منضم اسمه 

Newresult

عايزه لما اكتب اى قيمه فى الحقل غير المنضم واضغط زرار اضافه ياخد 

القيمه اللى اتسجلت فىه ويحفظها فى جدول تانى  اسمه

fixedresult_tbl

فى حقل اسمه

Fixedresult 

وكمان ياخد معاه قيمة fixedname

يحفظه فى حقل بنفس الاسم

تم تعديل بواسطه safaa salem5
رابط هذا التعليق
شارك
M.Abd Allah

M.Abd Allah

قام بنشر
قام بنشر
3 ساعات مضت, safaa salem5 said:

عندى فورم مصدره جدول  اسمه

Fixed_tbl

فيه حقل منضم اسمه

Fixedname

وعندى حقل غير منضم اسمه 

Newresult

عايزه لما اكتب اى قيمه فى الحقل غير المنضم واضغط زرار اضافه ياخد 

القيمه اللى اتسجلت فىه ويحفظها فى جدول تانى  اسمه

fixedresult_tbl

فى حقل اسمه

Fixedresult 

وكمان ياخد معاه قيمة fixedname

يحفظه فى حقل بنفس الاسم 

ممكن من خلال الكود التالي
Private Sub btnAdd_Click()
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim fixedNameValue As String
    Dim newResultValue As String
    
    ' الحصول على القيم من الحقول
    fixedNameValue = Me.Fixedname
    newResultValue = Me.Newresult
    ' التحقق من أن القيم ليست فارغة
    If IsNull(fixedNameValue) Or IsNull(newResultValue) Then
        MsgBox "يرجى ملء جميع الحقول قبل الإضافة.", vbExclamation
        Exit Sub
    End If
    ' فتح قاعدة البيانات
    Set db = CurrentDb
    
    ' فتح الجدول المراد الإضافة إليه
    Set rs = db.OpenRecordset("fixedresult_tbl", dbOpenDynaset)
    
    ' إضافة سجل جديد
    rs.AddNew
    rs!Fixedname = fixedNameValue
    rs!Fixedresult = newResultValue
    rs.Update
    
    ' إغلاق مجموعة السجلات
    rs.Close
    Set rs = Nothing
    Set db = Nothing
    
    ' إبلاغ المستخدم بالنجاح
    MsgBox "تمت الإضافة بنجاح!", vbInformation
End Sub

 

  • Like 1
رابط هذا التعليق
شارك
M.Abd Allah

M.Abd Allah

قام بنشر
قام بنشر
52 دقائق مضت, safaa salem5 said:

ممكن طريقه اسهل 

مع العلم  

Fixedname

حقل مشترك بين الجدولين 

طيب جربى الكود ده ان شاء الله هيشتغل كويس 
Private Sub btnAdd_Click()
    Dim db As DAO.Database
    Dim fixedNameValue As String
    Dim newResultValue As String
    Dim sql As String
    
    ' الحصول على القيم من الحقول
    fixedNameValue = Me.Fixedname
    newResultValue = Me.Newresult
    ' التحقق من أن القيم ليست فارغة
    If IsNull(fixedNameValue) Or fixedNameValue = "" Or IsNull(newResultValue) Or newResultValue = "" Then
        MsgBox "يرجى ملء جميع الحقول قبل الإضافة.", vbExclamation
        Exit Sub
    End If
    ' فتح قاعدة البيانات
    Set db = CurrentDb
    
    ' إنشاء تعليمة SQL لإضافة سجل جديد
    sql = "INSERT INTO fixedresult_tbl (Fixedname, Fixedresult) " & _
          "VALUES ('" & fixedNameValue & "', '" & newResultValue & "')"
    
    ' تنفيذ تعليمة SQL
    db.Execute sql, dbFailOnError
    
    ' إغلاق قاعدة البيانات
    Set db = Nothing
    
    ' إبلاغ المستخدم بالنجاح
    MsgBox "تمت الإضافة بنجاح!", vbInformation
End Sub

 

رابط هذا التعليق
شارك
safaa salem5

safaa salem5

قام بنشر
  • الكاتب
قام بنشر
10 hours ago, M.Abd Allah said: 
طيب جربى الكود ده ان شاء الله هيشتغل كويس 
Private Sub btnAdd_Click()
    Dim db As DAO.Database
    Dim fixedNameValue As String
    Dim newResultValue As String
    Dim sql As String
    
    ' الحصول على القيم من الحقول
    fixedNameValue = Me.Fixedname
    newResultValue = Me.Newresult
    ' التحقق من أن القيم ليست فارغة
    If IsNull(fixedNameValue) Or fixedNameValue = "" Or IsNull(newResultValue) Or newResultValue = "" Then
        MsgBox "يرجى ملء جميع الحقول قبل الإضافة.", vbExclamation
        Exit Sub
    End If
    ' فتح قاعدة البيانات
    Set db = CurrentDb
    
    ' إنشاء تعليمة SQL لإضافة سجل جديد
    sql = "INSERT INTO fixedresult_tbl (Fixedname, Fixedresult) " & _
          "VALUES ('" & fixedNameValue & "', '" & newResultValue & "')"
    
    ' تنفيذ تعليمة SQL
    db.Execute sql, dbFailOnError
    
    ' إغلاق قاعدة البيانات
    Set db = Nothing
    
    ' إبلاغ المستخدم بالنجاح
    MsgBox "تمت الإضافة بنجاح!", vbInformation
End Sub

تمام بس لو سيبت الحقل فاضى بيدينى رساله من الاكسيس وبيتجاهل الرساله اللى فى الكود

Screenshot_5.png

رابط هذا التعليق
شارك
M.Abd Allah

M.Abd Allah

قام بنشر
قام بنشر
30 دقائق مضت, safaa salem5 said:

Screenshot_5.png 

 

طيب جربي ده كده  

Private Sub btnAdd_Click()
    Dim db As DAO.Database
    Dim fixedNameValue As String
    Dim newResultValue As String
    Dim sql As String
    
    ' الحصول على القيم من الحقول والتحقق من أنها ليست Null
    If IsNull(Me.Fixedname) Or IsNull(Me.Newresult) Then
        MsgBox "يرجى ملء جميع الحقول قبل الإضافة.", vbExclamation
        Exit Sub
    End If
    
    fixedNameValue = Me.Fixedname.Value
    newResultValue = Me.Newresult.Value
    ' التحقق من أن القيم ليست فارغة
    If fixedNameValue = "" Or newResultValue = "" Then
        MsgBox "يرجى ملء جميع الحقول قبل الإضافة.", vbExclamation
        Exit Sub
    End If
    ' فتح قاعدة البيانات
    Set db = CurrentDb
    
    ' إنشاء تعليمة SQL لإضافة سجل جديد
    sql = "INSERT INTO fixedresult_tbl (Fixedname, Fixedresult) " & _
          "VALUES ('" & fixedNameValue & "', '" & newResultValue & "')"
    
    ' تنفيذ تعليمة SQL
    db.Execute sql, dbFailOnError
    
    ' إغلاق قاعدة البيانات
    Set db = Nothing
    
    ' إبلاغ المستخدم بالنجاح
    MsgBox "تمت الإضافة بنجاح!", vbInformation
End Sub

 

رابط هذا التعليق
شارك
safaa salem5

safaa salem5

قام بنشر
  • الكاتب
قام بنشر
15 minutes ago, M.Abd Allah said: 
 

طيب جربي ده كده  

Private Sub btnAdd_Click()
    Dim db As DAO.Database
    Dim fixedNameValue As String
    Dim newResultValue As String
    Dim sql As String
    
    ' الحصول على القيم من الحقول والتحقق من أنها ليست Null
    If IsNull(Me.Fixedname) Or IsNull(Me.Newresult) Then
        MsgBox "يرجى ملء جميع الحقول قبل الإضافة.", vbExclamation
        Exit Sub
    End If
    
    fixedNameValue = Me.Fixedname.Value
    newResultValue = Me.Newresult.Value
    ' التحقق من أن القيم ليست فارغة
    If fixedNameValue = "" Or newResultValue = "" Then
        MsgBox "يرجى ملء جميع الحقول قبل الإضافة.", vbExclamation
        Exit Sub
    End If
    ' فتح قاعدة البيانات
    Set db = CurrentDb
    
    ' إنشاء تعليمة SQL لإضافة سجل جديد
    sql = "INSERT INTO fixedresult_tbl (Fixedname, Fixedresult) " & _
          "VALUES ('" & fixedNameValue & "', '" & newResultValue & "')"
    
    ' تنفيذ تعليمة SQL
    db.Execute sql, dbFailOnError
    
    ' إغلاق قاعدة البيانات
    Set db = Nothing
    
    ' إبلاغ المستخدم بالنجاح
    MsgBox "تمت الإضافة بنجاح!", vbInformation
End Sub

 

تمام كدا

ممكن نضيف للكود

منع تكرار قيمة 

fixedresult

لنفس ال

fixedname

 

 

موجوده مسبقا 

رابط هذا التعليق
شارك
  • أفضل إجابة
M.Abd Allah

M.Abd Allah

قام بنشر
  • أفضل إجابة
قام بنشر
49 دقائق مضت, safaa salem5 said:

تمام كدا

ممكن نضيف للكود

منع تكرار قيمة 

fixedresult

لنفس ال

fixedname

 

 

موجوده مسبقا 

تمام يبقي استخدمي الكود ده  

Private Sub btnAdd_Click()
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim fixedNameValue As String
    Dim newResultValue As String
    Dim sql As String
    
    ' الحصول على القيم من الحقول والتحقق من أنها ليست Null
    If IsNull(Me.Fixedname) Or IsNull(Me.Newresult) Then
        MsgBox "يرجى ملء جميع الحقول قبل الإضافة.", vbExclamation
        Exit Sub
    End If
    
    fixedNameValue = Me.Fixedname.Value
    newResultValue = Me.Newresult.Value
    ' التحقق من أن القيم ليست فارغة
    If fixedNameValue = "" Or newResultValue = "" Then
        MsgBox "يرجى ملء جميع الحقول قبل الإضافة.", vbExclamation
        Exit Sub
    End If
    ' فتح قاعدة البيانات
    Set db = CurrentDb
    
    ' التحقق من عدم وجود قيمة مكررة لنفس Fixedname و Fixedresult
    sql = "SELECT COUNT(*) AS RecordCount FROM fixedresult_tbl WHERE Fixedname = '" & fixedNameValue & "' AND Fixedresult = '" & newResultValue & "'"
    Set rs = db.OpenRecordset(sql)
    
    If Not rs.EOF And rs!RecordCount > 0 Then
        MsgBox "القيمة المدخلة موجودة مسبقًا لنفس الاسم الثابت.", vbExclamation
        rs.Close
        Set rs = Nothing
        Set db = Nothing
        Exit Sub
    End If
    
    rs.Close
    Set rs = Nothing
    
    ' إنشاء تعليمة SQL لإضافة سجل جديد
    sql = "INSERT INTO fixedresult_tbl (Fixedname, Fixedresult) " & _
          "VALUES ('" & fixedNameValue & "', '" & newResultValue & "')"
    
    ' تنفيذ تعليمة SQL
    db.Execute sql, dbFailOnError
    
    ' إغلاق قاعدة البيانات
    Set db = Nothing
    
    ' إبلاغ المستخدم بالنجاح
    MsgBox "تمت الإضافة بنجاح!", vbInformation
End Sub

 

  • Like 1
رابط هذا التعليق
شارك
safaa salem5

safaa salem5

قام بنشر
  • الكاتب
قام بنشر (معدل)
On 6/24/2024 at 7:37 PM, M.Abd Allah said: 
ممكن من خلال الكود التالي
Private Sub btnAdd_Click()
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim fixedNameValue As String
    Dim newResultValue As String
    
    ' الحصول على القيم من الحقول
    fixedNameValue = Me.Fixedname
    newResultValue = Me.Newresult
    ' التحقق من أن القيم ليست فارغة
    If IsNull(fixedNameValue) Or IsNull(newResultValue) Then
        MsgBox "يرجى ملء جميع الحقول قبل الإضافة.", vbExclamation
        Exit Sub
    End If
    ' فتح قاعدة البيانات
    Set db = CurrentDb
    
    ' فتح الجدول المراد الإضافة إليه
    Set rs = db.OpenRecordset("fixedresult_tbl", dbOpenDynaset)
    
    ' إضافة سجل جديد
    rs.AddNew
    rs!Fixedname = fixedNameValue
    rs!Fixedresult = newResultValue
    rs.Update
    
    ' إغلاق مجموعة السجلات
    rs.Close
    Set rs = Nothing
    Set db = Nothing
    
    ' إبلاغ المستخدم بالنجاح
    MsgBox "تمت الإضافة بنجاح!", vbInformation
End Sub

 

@M.Abd Allahممكن لو سمحت استاذ محمد

عايزه اضيف شرط هنا

اثناء الضغط على زرار اضافه يشوف لو الحقول دى

fixeddefault

fixednormal

Reportname

هتكون موجوده فى نفس الفورم لوفيها قيم يضيف عادى 

(لو مفهاش قيم تخرج رساله (يرجى ادخال البيانات قبل الاضافه

واول مايتم ملاؤهم يقبل الاضافه عادى

والقيم اللى اتكتبت فى الفيلدات التلاته  تروح للجدول اللى اسمه 

Fixed_tbl

هو بالشكل اللى ف الصوره

 

 

 

Screenshot_3.png

تم تعديل بواسطه safaa salem5
رابط هذا التعليق
شارك
M.Abd Allah

M.Abd Allah

قام بنشر
قام بنشر 
Private Sub btnAdd_Click()
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim fixedNameValue As String
    Dim newResultValue As String
    Dim fixedDefaultValue As Variant
    Dim fixedNormalValue As Variant
    Dim reportNameValue As Variant
    
    ' الحصول على القيم من الحقول
    fixedNameValue = Me.Fixedname
    newResultValue = Me.Newresult
    fixedDefaultValue = Me.fixeddefault
    fixedNormalValue = Me.fixednormal
    reportNameValue = Me.Reportname
    ' التحقق من أن القيم ليست فارغة
    If IsNull(fixedNameValue) Or IsNull(newResultValue) Then
        MsgBox "يرجى ملء جميع الحقول قبل الإضافة.", vbExclamation
        Exit Sub
    End If
    ' التحقق من أن الحقول الثلاثة ليست فارغة
    If IsNull(fixedDefaultValue) Or IsNull(fixedNormalValue) Or IsNull(reportNameValue) Then
        MsgBox "يرجى إدخال بيانات الحقول الثلاثة (fixeddefault, fixednormal, Reportname) قبل الإضافة.", vbExclamation
        Exit Sub
    End If
    ' فتح قاعدة البيانات
    Set db = CurrentDb
    
    ' فتح الجدول المراد الإضافة إليه
    Set rs = db.OpenRecordset("fixedresult_tbl", dbOpenDynaset)
    
    ' إضافة سجل جديد
    rs.AddNew
    rs!Fixedname = fixedNameValue
    rs!Fixedresult = newResultValue
    rs.Update
    ' إغلاق مجموعة السجلات
    rs.Close
    Set rs = Nothing
    ' فتح الجدول المراد التحديث إليه
    Set rs = db.OpenRecordset("Fixed_tbl", dbOpenDynaset)
    ' التحقق مما إذا كان السجل موجود بالفعل
    rs.FindFirst "fixedname = '" & fixedNameValue & "'"
    If rs.NoMatch Then
        ' إضافة سجل جديد
        rs.AddNew
        rs!fixedname = fixedNameValue
    Else
        ' تعديل السجل الموجود
        rs.Edit
    End If
    ' تحديث القيم في السجل
    rs!fixeddefault = fixedDefaultValue
    rs!fixednormal = fixedNormalValue
    rs!Reportname = reportNameValue
    rs.Update
    
    ' إغلاق مجموعة السجلات
    rs.Close
    Set rs = Nothing
    Set db = Nothing
    
    ' إبلاغ المستخدم بالنجاح
    MsgBox "تمت الإضافة بنجاح!", vbInformation
End Sub

جربي كده 

رابط هذا التعليق
شارك
safaa salem5

safaa salem5

قام بنشر
  • الكاتب
قام بنشر (معدل)
2 hours ago, M.Abd Allah said: 
Private Sub btnAdd_Click()
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim fixedNameValue As String
    Dim newResultValue As String
    Dim fixedDefaultValue As Variant
    Dim fixedNormalValue As Variant
    Dim reportNameValue As Variant
    
    ' الحصول على القيم من الحقول
    fixedNameValue = Me.Fixedname
    newResultValue = Me.Newresult
    fixedDefaultValue = Me.fixeddefault
    fixedNormalValue = Me.fixednormal
    reportNameValue = Me.Reportname
    ' التحقق من أن القيم ليست فارغة
    If IsNull(fixedNameValue) Or IsNull(newResultValue) Then
        MsgBox "يرجى ملء جميع الحقول قبل الإضافة.", vbExclamation
        Exit Sub
    End If
    ' التحقق من أن الحقول الثلاثة ليست فارغة
    If IsNull(fixedDefaultValue) Or IsNull(fixedNormalValue) Or IsNull(reportNameValue) Then
        MsgBox "يرجى إدخال بيانات الحقول الثلاثة (fixeddefault, fixednormal, Reportname) قبل الإضافة.", vbExclamation
        Exit Sub
    End If
    ' فتح قاعدة البيانات
    Set db = CurrentDb
    
    ' فتح الجدول المراد الإضافة إليه
    Set rs = db.OpenRecordset("fixedresult_tbl", dbOpenDynaset)
    
    ' إضافة سجل جديد
    rs.AddNew
    rs!Fixedname = fixedNameValue
    rs!Fixedresult = newResultValue
    rs.Update
    ' إغلاق مجموعة السجلات
    rs.Close
    Set rs = Nothing
    ' فتح الجدول المراد التحديث إليه
    Set rs = db.OpenRecordset("Fixed_tbl", dbOpenDynaset)
    ' التحقق مما إذا كان السجل موجود بالفعل
    rs.FindFirst "fixedname = '" & fixedNameValue & "'"
    If rs.NoMatch Then
        ' إضافة سجل جديد
        rs.AddNew
        rs!fixedname = fixedNameValue
    Else
        ' تعديل السجل الموجود
        rs.Edit
    End If
    ' تحديث القيم في السجل
    rs!fixeddefault = fixedDefaultValue
    rs!fixednormal = fixedNormalValue
    rs!Reportname = reportNameValue
    rs.Update
    
    ' إغلاق مجموعة السجلات
    rs.Close
    Set rs = Nothing
    Set db = Nothing
    
    ' إبلاغ المستخدم بالنجاح
    MsgBox "تمت الإضافة بنجاح!", vbInformation
End Sub

جربي كده 

بص انا عملت ميكس بين الكودين  بالشكل دا

 


    Dim rs As DAO.Recordset
    Dim fixedNameValue As String
    Dim newResultValue As String
    Dim fixedDefaultValue As Variant
    Dim fixedNormalValue As Variant
    Dim reportNameValue As Variant
    

    fixedNameValue = Me.testnameN
    newResultValue = Me.Newresult
    fixedDefaultValue = Me.fixeddefault
    fixedNormalValue = Me.fixednormal
    reportNameValue = Me.Reportname
    
    
       
    If IsNull(fixedDefaultValue) Or IsNull(fixedNormalValue) Or IsNull(reportNameValue) Then
        MsgBox "ÝÖáÇ íÑÌì ÇÓÊßãÇá ÈÇÞì ÈíÇäÇÊ (fixeddefault, fixednormal, Reportname)  ÞÈá ÇáÅÖÇÝÉ.", vbExclamation
        Exit Sub
    End If
    
    
   
    If IsNull(fixedNameValue) Or IsNull(newResultValue) Then
        MsgBox "+ ÖÚ  ÇáÞíãå ÇáãÑÇÏ ÇÖÇÝÊåÇ Ëã ÇÖÛØ ÒÑÇÑ", vbExclamation
        Exit Sub
    End If
 
    
    
   
     Set db = CurrentDb
    
    
    sql = "SELECT COUNT(*) AS RecordCount FROM fixedresults_tbl WHERE Fixedname = '" & fixedNameValue & "' AND Fixedresult = '" & newResultValue & "'"
    Set rs = db.OpenRecordset(sql)
    
    If Not rs.EOF And rs!RecordCount > 0 Then
        MsgBox "ÇáÞíãÉ ÇáãÏÎáÉ ãæÌæÏÉ ãÓÈÞðÇ.", vbExclamation
        rs.Close
        Set rs = Nothing
        Set db = Nothing
        Exit Sub
    End If
    
    rs.Close
    Set rs = Nothing
    
    MAXCODE = DMax("code", "fixedresults_tbl")
    Me.code.Value = MAXCODE + 1
    
  
    sql = "INSERT INTO fixedresults_tbl (code,Fixedname, Fixedresult) " & _
          "VALUES ('" & code & "', '" & fixedNameValue & "', '" & newResultValue & "')"
   
    db.Execute sql, dbFailOnError
       Set db = Nothing
 
    
     Resultlist.Requery
    Newresult.Value = ""
    
    MsgBox "ÊãÊ ÇáÇÖÇÝå", vbInformation
    
    
    
    
    ' ÝÊÍ ÇáÌÏæá ÇáãÑÇÏ ÇáÊÍÏíË áå
    Set rs = db.OpenRecordset("Fixed_tbl", dbOpenDynaset)
    ' ÇáÊÍÞÞ ãä ÇÐÇ ßÇä ÇáÓÌá ãæÌæÏ ÈÇáÝÚá
    rs.FindFirst "fixedname = '" & fixedNameValue & "'"
    If rs.NoMatch Then
        ' ÇÖÇÝÉ ÓÌá ÌÏíÏ
        rs.AddNew
        rs!fixedname = fixedNameValue
    Else
        ' ÊÚÏíá ÇáÓÌá ÇáãæÌæÏ
        rs.Edit
    End If
    ' ÊÍÏíË ÇáÞíã Ý ÇáÓÌá
    rs!fixeddefault = fixedDefaultValue
    rs!fixednormal = fixedNormalValue
    rs!Reportname = reportNameValue
    rs!fixedname = fixedNameValue
    rs.Update
    
   
    rs.Close
    Set rs = Nothing
    Set db = Nothing
    
  
    MsgBox "ÊãÊ ÇáÇÖÇÝå!", vbInformation

End Sub

بس عندى مشكله فى الجدول الاخير مش بيكتب قيمة fixedname

رحت انا اضفتها للكود بس برده بيطلع قيمته فى الجدول فاضى

وفى حاجه تانيه بعد مابيضيف بيدينى رساله دى

@M.Abd Allah

4 minutes ago, safaa salem5 said:

 

 

 

 

 

Screenshot_4.png

تم تعديل بواسطه safaa salem5
رابط هذا التعليق
شارك
M.Abd Allah

M.Abd Allah

قام بنشر
قام بنشر

طبقا للميكس اللي عملتيه جربي تعديل الكود ده  

    On Error GoTo ErrorHandler
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim fixedNameValue As String
    Dim newResultValue As String
    Dim fixedDefaultValue As Variant
    Dim fixedNormalValue As Variant
    Dim reportNameValue As Variant
    Dim sql As String
    Dim MAXCODE As Long
    
    ' الحصول على القيم من الحقول
    fixedNameValue = Me.testnameN
    newResultValue = Me.Newresult
    fixedDefaultValue = Me.fixeddefault
    fixedNormalValue = Me.fixednormal
    reportNameValue = Me.Reportname
    
    ' التحقق من أن الحقول الثلاثة ليست فارغة
    If IsNull(fixedDefaultValue) Or IsNull(fixedNormalValue) Or IsNull(reportNameValue) Then
        MsgBox "يرجى استكمال باقي البيانات (fixeddefault, fixednormal, Reportname) قبل الإضافة.", vbExclamation
        Exit Sub
    End If
    
    ' التحقق من أن القيم ليست فارغة
    If IsNull(fixedNameValue) Or IsNull(newResultValue) Then
        MsgBox "يرجى ملء جميع الحقول قبل الإضافة ثم الضغط على الزرار", vbExclamation
        Exit Sub
    End If
    
    ' فتح قاعدة البيانات
    Set db = CurrentDb
    
    ' التحقق من عدم تكرار السجل
    sql = "SELECT COUNT(*) AS RecordCount FROM fixedresults_tbl WHERE Fixedname = '" & fixedNameValue & "' AND Fixedresult = '" & newResultValue & "'"
    Set rs = db.OpenRecordset(sql)
    
    If Not rs.EOF And rs!RecordCount > 0 Then
        MsgBox "القيمة المدخلة موجودة مسبقاً.", vbExclamation
        rs.Close
        Set rs = Nothing
        Set db = Nothing
        Exit Sub
    End If
    
    rs.Close
    Set rs = Nothing
    
    ' الحصول على قيمة الكود الجديدة
    MAXCODE = Nz(DMax("code", "fixedresults_tbl"), 0)
    Me.code.Value = MAXCODE + 1
    
    ' إضافة السجل الجديد في fixedresults_tbl
    sql = "INSERT INTO fixedresults_tbl (code, Fixedname, Fixedresult) " & _
          "VALUES (" & Me.code.Value & ", '" & fixedNameValue & "', '" & newResultValue & "')"
    db.Execute sql, dbFailOnError
    ' تحديث القائمة
    Resultlist.Requery
    Newresult.Value = ""
    
    ' إبلاغ المستخدم بالنجاح
    MsgBox "تمت الإضافة بنجاح!", vbInformation
    ' فتح الجدول Fixed_tbl للتحقق من وجود السجل وتحديثه أو إضافته
    Set rs = db.OpenRecordset("Fixed_tbl", dbOpenDynaset)
    rs.FindFirst "fixedname = '" & fixedNameValue & "'"
    If rs.NoMatch Then
        rs.AddNew
        rs!fixedname = fixedNameValue
    Else
        rs.Edit
    End If
    rs!fixeddefault = fixedDefaultValue
    rs!fixednormal = fixedNormalValue
    rs!Reportname = reportNameValue
    rs.Update
    
    rs.Close
    Set rs = Nothing
    Set db = Nothing
    Exit Sub
ErrorHandler:
    MsgBox "حدث خطأ: " & Err.Description, vbCritical
    If Not rs Is Nothing Then
        rs.Close
        Set rs = Nothing
    End If
    If Not db Is Nothing Then
        Set db = Nothing
    End If

 

رابط هذا التعليق
شارك
safaa salem5

safaa salem5

قام بنشر
  • الكاتب
قام بنشر (معدل)
10 hours ago, M.Abd Allah said:

طبقا للميكس اللي عملتيه جربي تعديل الكود ده  

    On Error GoTo ErrorHandler
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim fixedNameValue As String
    Dim newResultValue As String
    Dim fixedDefaultValue As Variant
    Dim fixedNormalValue As Variant
    Dim reportNameValue As Variant
    Dim sql As String
    Dim MAXCODE As Long
    
    ' الحصول على القيم من الحقول
    fixedNameValue = Me.testnameN
    newResultValue = Me.Newresult
    fixedDefaultValue = Me.fixeddefault
    fixedNormalValue = Me.fixednormal
    reportNameValue = Me.Reportname
    
    ' التحقق من أن الحقول الثلاثة ليست فارغة
    If IsNull(fixedDefaultValue) Or IsNull(fixedNormalValue) Or IsNull(reportNameValue) Then
        MsgBox "يرجى استكمال باقي البيانات (fixeddefault, fixednormal, Reportname) قبل الإضافة.", vbExclamation
        Exit Sub
    End If
    
    ' التحقق من أن القيم ليست فارغة
    If IsNull(fixedNameValue) Or IsNull(newResultValue) Then
        MsgBox "يرجى ملء جميع الحقول قبل الإضافة ثم الضغط على الزرار", vbExclamation
        Exit Sub
    End If
    
    ' فتح قاعدة البيانات
    Set db = CurrentDb
    
    ' التحقق من عدم تكرار السجل
    sql = "SELECT COUNT(*) AS RecordCount FROM fixedresults_tbl WHERE Fixedname = '" & fixedNameValue & "' AND Fixedresult = '" & newResultValue & "'"
    Set rs = db.OpenRecordset(sql)
    
    If Not rs.EOF And rs!RecordCount > 0 Then
        MsgBox "القيمة المدخلة موجودة مسبقاً.", vbExclamation
        rs.Close
        Set rs = Nothing
        Set db = Nothing
        Exit Sub
    End If
    
    rs.Close
    Set rs = Nothing
    
    ' الحصول على قيمة الكود الجديدة
    MAXCODE = Nz(DMax("code", "fixedresults_tbl"), 0)
    Me.code.Value = MAXCODE + 1
    
    ' إضافة السجل الجديد في fixedresults_tbl
    sql = "INSERT INTO fixedresults_tbl (code, Fixedname, Fixedresult) " & _
          "VALUES (" & Me.code.Value & ", '" & fixedNameValue & "', '" & newResultValue & "')"
    db.Execute sql, dbFailOnError
    ' تحديث القائمة
    Resultlist.Requery
    Newresult.Value = ""
    
    ' إبلاغ المستخدم بالنجاح
    MsgBox "تمت الإضافة بنجاح!", vbInformation
    ' فتح الجدول Fixed_tbl للتحقق من وجود السجل وتحديثه أو إضافته
    Set rs = db.OpenRecordset("Fixed_tbl", dbOpenDynaset)
    rs.FindFirst "fixedname = '" & fixedNameValue & "'"
    If rs.NoMatch Then
        rs.AddNew
        rs!fixedname = fixedNameValue
    Else
        rs.Edit
    End If
    rs!fixeddefault = fixedDefaultValue
    rs!fixednormal = fixedNormalValue
    rs!Reportname = reportNameValue
    rs.Update
    
    rs.Close
    Set rs = Nothing
    Set db = Nothing
    Exit Sub
ErrorHandler:
    MsgBox "حدث خطأ: " & Err.Description, vbCritical
    If Not rs Is Nothing Then
        rs.Close
        Set rs = Nothing
    End If
    If Not db Is Nothing Then
        Set db = Nothing
    End If

 

ف البدايه حابه اشكرك جدا 

عندى نقطه اتحلت  ان اسم fixedname 

بدأ يدخل الجدول

لكن فى رساله خطأ جديده من الاكسيس ظهرت غير الاولى 

 

النقطه التانيه انا عايزه امنع تكرار

fixedname 

فى جدول

fixedt_tbl

لان فى اول عملية اضافه بيضيف سجلين  فى الجدول دا 

واحد فى اسم

fixedname 

والتانى مفهوش 

@M.Abd Allah

Screenshot_2.png

Screenshot_3.png

تم تعديل بواسطه safaa salem5
رابط هذا التعليق
شارك
M.Abd Allah

M.Abd Allah

قام بنشر
قام بنشر
4 ساعات مضت, safaa salem5 said:

ف البدايه حابه اشكرك جدا 

عندى نقطه اتحلت  ان اسم fixedname 

بدأ يدخل الجدول

لكن فى رساله خطأ جديده من الاكسيس ظهرت غير الاولى 

 

النقطه التانيه انا عايزه امنع تكرار

fixedname 

فى جدول

fixedt_tbl

لان فى اول عملية اضافه بيضيف سجلين  فى الجدول دا 

واحد فى اسم

fixedname 

والتانى مفهوش 

@M.Abd Allah

Screenshot_2.png

Screenshot_3.png

جربي الكود ده إن شاء الله هيظبط معاكي  

    On Error GoTo ErrorHandler
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim fixedNameValue As String
    Dim newResultValue As String
    Dim fixedDefaultValue As Variant
    Dim fixedNormalValue As Variant
    Dim reportNameValue As Variant
    Dim sql As String
    Dim MAXCODE As Long
    
    ' الحصول على القيم من الحقول
    fixedNameValue = Me.testnameN
    newResultValue = Me.Newresult
    fixedDefaultValue = Me.fixeddefault
    fixedNormalValue = Me.fixednormal
    reportNameValue = Me.Reportname
    
    ' التحقق من أن الحقول الثلاثة ليست فارغة
    If IsNull(fixedDefaultValue) Or IsNull(fixedNormalValue) Or IsNull(reportNameValue) Then
        MsgBox "يرجى استكمال باقي البيانات (fixeddefault, fixednormal, Reportname) قبل الإضافة.", vbExclamation
        Exit Sub
    End If
    
    ' التحقق من أن القيم ليست فارغة
    If IsNull(fixedNameValue) Or IsNull(newResultValue) Then
        MsgBox "يرجى ملء جميع الحقول قبل الإضافة ثم الضغط على الزرار", vbExclamation
        Exit Sub
    End If
    
    ' فتح قاعدة البيانات
    Set db = CurrentDb
    
    ' التحقق من عدم تكرار السجل في fixedresults_tbl
    sql = "SELECT COUNT(*) AS RecordCount FROM fixedresults_tbl WHERE Fixedname = '" & fixedNameValue & "' AND Fixedresult = '" & newResultValue & "'"
    Set rs = db.OpenRecordset(sql)
    
    If Not rs.EOF And rs!RecordCount > 0 Then
        MsgBox "القيمة المدخلة موجودة مسبقاً.", vbExclamation
        rs.Close
        Set rs = Nothing
        Set db = Nothing
        Exit Sub
    End If
    
    rs.Close
    Set rs = Nothing
    
    ' الحصول على قيمة الكود الجديدة
    MAXCODE = Nz(DMax("code", "fixedresults_tbl"), 0)
    Me.code.Value = MAXCODE + 1
    
    ' إضافة السجل الجديد في fixedresults_tbl
    sql = "INSERT INTO fixedresults_tbl (code, Fixedname, Fixedresult) " & _
          "VALUES (" & Me.code.Value & ", '" & fixedNameValue & "', '" & newResultValue & "')"
    db.Execute sql, dbFailOnError
    ' تحديث القائمة
    Resultlist.Requery
    Newresult.Value = ""
    
    ' فتح الجدول Fixed_tbl للتحقق من وجود السجل وتحديثه أو إضافته
    sql = "SELECT * FROM Fixed_tbl WHERE fixedname = '" & fixedNameValue & "'"
    Set rs = db.OpenRecordset(sql)
    If rs.EOF Then
        rs.AddNew
        rs!fixedname = fixedNameValue
    Else
        rs.Edit
    End If
    rs!fixeddefault = fixedDefaultValue
    rs!fixednormal = fixedNormalValue
    rs!Reportname = reportNameValue
    rs.Update
    
    rs.Close
    Set rs = Nothing
    Set db = Nothing
    MsgBox "تمت الإضافة بنجاح!", vbInformation
    Exit Sub
ErrorHandler:
    MsgBox "حدث خطأ: " & Err.Description, vbCritical
    If Not rs Is Nothing Then
        rs.Close
        Set rs = Nothing
    End If
    If Not db Is Nothing Then
        Set db = Nothing
    End If

 

رابط هذا التعليق
شارك
M.Abd Allah

M.Abd Allah

قام بنشر
قام بنشر
2 دقائق مضت, safaa salem5 said:

بردو بيعمل سجلين واحد كامل البيانات وواحد بدون قيمه فى حقل fixed name 

عادي مفيش مشكله  

    On Error GoTo ErrorHandler
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim fixedNameValue As String
    Dim newResultValue As String
    Dim fixedDefaultValue As Variant
    Dim fixedNormalValue As Variant
    Dim reportNameValue As Variant
    Dim sql As String
    Dim MAXCODE As Long
    
    ' الحصول على القيم من الحقول
    fixedNameValue = Me.testnameN
    newResultValue = Me.Newresult
    fixedDefaultValue = Me.fixeddefault
    fixedNormalValue = Me.fixednormal
    reportNameValue = Me.Reportname
    
    ' التحقق من أن الحقول الثلاثة ليست فارغة
    If IsNull(fixedDefaultValue) Or IsNull(fixedNormalValue) Or IsNull(reportNameValue) Then
        MsgBox "يرجى استكمال باقي البيانات (fixeddefault, fixednormal, Reportname) قبل الإضافة.", vbExclamation
        Exit Sub
    End If
    
    ' التحقق من أن القيم ليست فارغة
    If IsNull(fixedNameValue) Or IsNull(newResultValue) Then
        MsgBox "يرجى ملء جميع الحقول قبل الإضافة ثم الضغط على الزرار", vbExclamation
        Exit Sub
    End If
    
    ' فتح قاعدة البيانات
    Set db = CurrentDb
    
    ' التحقق من عدم تكرار السجل في fixedresults_tbl
    sql = "SELECT COUNT(*) AS RecordCount FROM fixedresults_tbl WHERE Fixedname = '" & fixedNameValue & "' AND Fixedresult = '" & newResultValue & "'"
    Set rs = db.OpenRecordset(sql)
    
    If Not rs.EOF And rs!RecordCount > 0 Then
        MsgBox "القيمة المدخلة موجودة مسبقاً.", vbExclamation
        rs.Close
        Set rs = Nothing
        Set db = Nothing
        Exit Sub
    End If
    
    rs.Close
    Set rs = Nothing
    
    ' الحصول على قيمة الكود الجديدة
    MAXCODE = Nz(DMax("code", "fixedresults_tbl"), 0)
    Me.code.Value = MAXCODE + 1
    
    ' إضافة السجل الجديد في fixedresults_tbl
    sql = "INSERT INTO fixedresults_tbl (code, Fixedname, Fixedresult) " & _
          "VALUES (" & Me.code.Value & ", '" & fixedNameValue & "', '" & newResultValue & "')"
    db.Execute sql, dbFailOnError
    ' تحديث القائمة
    Resultlist.Requery
    Newresult.Value = ""
    
    ' فتح الجدول Fixed_tbl للتحقق من وجود السجل وتحديثه أو إضافته
    sql = "SELECT * FROM Fixed_tbl WHERE fixedname = '" & fixedNameValue & "'"
    Set rs = db.OpenRecordset(sql)
    If rs.EOF Then
        rs.AddNew
    Else
        rs.Edit
    End If
    rs!fixedname = fixedNameValue
    rs!fixeddefault = fixedDefaultValue
    rs!fixednormal = fixedNormalValue
    rs!Reportname = reportNameValue
    rs.Update
    
    rs.Close
    Set rs = Nothing
    Set db = Nothing
    MsgBox "تمت الإضافة بنجاح!", vbInformation
    Exit Sub
ErrorHandler:
    MsgBox "حدث خطأ: " & Err.Description, vbCritical
    If Not rs Is Nothing Then
        rs.Close
        Set rs = Nothing
    End If
    If Not db Is Nothing Then
        Set db = Nothing
    End If

 

رابط هذا التعليق
شارك
safaa salem5

safaa salem5

قام بنشر
  • الكاتب
قام بنشر
3 hours ago, M.Abd Allah said:

عادي مفيش مشكله  

    On Error GoTo ErrorHandler
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim fixedNameValue As String
    Dim newResultValue As String
    Dim fixedDefaultValue As Variant
    Dim fixedNormalValue As Variant
    Dim reportNameValue As Variant
    Dim sql As String
    Dim MAXCODE As Long
    
    ' الحصول على القيم من الحقول
    fixedNameValue = Me.testnameN
    newResultValue = Me.Newresult
    fixedDefaultValue = Me.fixeddefault
    fixedNormalValue = Me.fixednormal
    reportNameValue = Me.Reportname
    
    ' التحقق من أن الحقول الثلاثة ليست فارغة
    If IsNull(fixedDefaultValue) Or IsNull(fixedNormalValue) Or IsNull(reportNameValue) Then
        MsgBox "يرجى استكمال باقي البيانات (fixeddefault, fixednormal, Reportname) قبل الإضافة.", vbExclamation
        Exit Sub
    End If
    
    ' التحقق من أن القيم ليست فارغة
    If IsNull(fixedNameValue) Or IsNull(newResultValue) Then
        MsgBox "يرجى ملء جميع الحقول قبل الإضافة ثم الضغط على الزرار", vbExclamation
        Exit Sub
    End If
    
    ' فتح قاعدة البيانات
    Set db = CurrentDb
    
    ' التحقق من عدم تكرار السجل في fixedresults_tbl
    sql = "SELECT COUNT(*) AS RecordCount FROM fixedresults_tbl WHERE Fixedname = '" & fixedNameValue & "' AND Fixedresult = '" & newResultValue & "'"
    Set rs = db.OpenRecordset(sql)
    
    If Not rs.EOF And rs!RecordCount > 0 Then
        MsgBox "القيمة المدخلة موجودة مسبقاً.", vbExclamation
        rs.Close
        Set rs = Nothing
        Set db = Nothing
        Exit Sub
    End If
    
    rs.Close
    Set rs = Nothing
    
    ' الحصول على قيمة الكود الجديدة
    MAXCODE = Nz(DMax("code", "fixedresults_tbl"), 0)
    Me.code.Value = MAXCODE + 1
    
    ' إضافة السجل الجديد في fixedresults_tbl
    sql = "INSERT INTO fixedresults_tbl (code, Fixedname, Fixedresult) " & _
          "VALUES (" & Me.code.Value & ", '" & fixedNameValue & "', '" & newResultValue & "')"
    db.Execute sql, dbFailOnError
    ' تحديث القائمة
    Resultlist.Requery
    Newresult.Value = ""
    
    ' فتح الجدول Fixed_tbl للتحقق من وجود السجل وتحديثه أو إضافته
    sql = "SELECT * FROM Fixed_tbl WHERE fixedname = '" & fixedNameValue & "'"
    Set rs = db.OpenRecordset(sql)
    If rs.EOF Then
        rs.AddNew
    Else
        rs.Edit
    End If
    rs!fixedname = fixedNameValue
    rs!fixeddefault = fixedDefaultValue
    rs!fixednormal = fixedNormalValue
    rs!Reportname = reportNameValue
    rs.Update
    
    rs.Close
    Set rs = Nothing
    Set db = Nothing
    MsgBox "تمت الإضافة بنجاح!", vbInformation
    Exit Sub
ErrorHandler:
    MsgBox "حدث خطأ: " & Err.Description, vbCritical
    If Not rs Is Nothing Then
        rs.Close
        Set rs = Nothing
    End If
    If Not db Is Nothing Then
        Set db = Nothing
    End If

 

بيعمل سجلين اتنين

Screenshot_5.png

رابط هذا التعليق
شارك
ابو جودي

ابو جودي

قام بنشر
قام بنشر

هو المفروض ايه اللى يحصل طيب معلش لان انا مش متابع من الاول علشان ننجز بدل ما الف كتير على ما افهم 

قولى لى السيناريو المطلوب تحقيقة نظريا بعيد عن الاكواد بس علشان اقدر افهم الاول

وانا لو تفتكرى يا دكتور فى البداية نصحتك وما اتنصحتيش

قلت لك اختارى اسماء الحقول تدل على وظيفتها هى والمتغيرات علشان تحليل الكود يكون سلسل 

منا قلت لك يا ست هانم لازم ازعق يعنى 😡

لازم نقضل نلف حوالين نفسينا علشان نفهم 

ياربى يعنى ياربى الجو حر وكمان سيادة الدكتور تطلع عنينا :biggrin2:

رابط هذا التعليق
شارك
ابو جودي

ابو جودي

قام بنشر
قام بنشر

جربى الكود دع يا دكتور

  

Private Sub btnAdd_Click()
    On Error GoTo ErrorHandler

    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim fixedNameValue As String
    Dim newResultValue As String
    Dim fixedDefaultValue As Variant
    Dim fixedNormalValue As Variant
    Dim reportNameValue As Variant
    Dim sql As String
    Dim MAXCODE As Long

    ' الحصول على القيم من الحقول
    fixedNameValue = Me.testnameN
    newResultValue = Me.Newresult
    fixedDefaultValue = Me.fixeddefault
    fixedNormalValue = Me.fixednormal
    reportNameValue = Me.Reportname

    ' التحقق من أن القيم ليست فارغة
    If IsNull(fixedDefaultValue) Or IsNull(fixedNormalValue) Or IsNull(reportNameValue) Then
        MsgBox "يرجى استكمال باقي البيانات (fixeddefault, fixednormal, Reportname) قبل الإضافة.", vbExclamation
        Exit Sub
    End If

    If IsNull(fixedNameValue) Or IsNull(newResultValue) Then
        MsgBox "يجب إدخال القيم المراد إضافتها ثم الضغط على زر الإضافة.", vbExclamation
        Exit Sub
    End If

    ' فتح قاعدة البيانات
    Set db = CurrentDb

    ' التحقق مما إذا كانت القيم موجودة بالفعل
    sql = "SELECT COUNT(*) AS RecordCount FROM fixedresults_tbl WHERE Fixedname = '" & fixedNameValue & "' AND Fixedresult = '" & newResultValue & "'"
    Set rs = db.OpenRecordset(sql)

    If Not rs.EOF And rs!RecordCount > 0 Then
        MsgBox "القيمة المدخلة موجودة مسبقًا.", vbExclamation
        rs.Close
        Set rs = Nothing
        Set db = Nothing
        Exit Sub
    End If

    rs.Close
    Set rs = Nothing

    ' تحديد الرقم الجديد
    MAXCODE = Nz(DMax("code", "fixedresults_tbl"), 0)
    Me.code.Value = MAXCODE + 1

    ' إضافة السجل الجديد إلى fixedresults_tbl
    sql = "INSERT INTO fixedresults_tbl (code, Fixedname, Fixedresult) " & _
          "VALUES (" & Me.code.Value & ", '" & fixedNameValue & "', '" & newResultValue & "')"
    db.Execute sql, dbFailOnError

    ' إعادة تحميل القائمة وتفريغ الحقول
    Resultlist.Requery
    Me.Newresult.Value = ""

    MsgBox "تمت الإضافة بنجاح!", vbInformation

    ' فتح الجدول المراد التحديث له
    Set rs = db.OpenRecordset("Fixed_tbl", dbOpenDynaset)

    ' التحقق مما إذا كان السجل موجود بالفعل لمنع التكرار
    rs.FindFirst "fixedname = '" & fixedNameValue & "'"
    If rs.NoMatch Then
        ' إضافة سجل جديد
        rs.AddNew
        rs!fixedname = fixedNameValue
        rs!fixeddefault = fixedDefaultValue
        rs!fixednormal = fixedNormalValue
        rs!Reportname = reportNameValue
        rs.Update
    Else
        ' تحديث السجل الموجود
        rs.Edit
        rs!fixeddefault = fixedDefaultValue
        rs!fixednormal = fixedNormalValue
        rs!Reportname = reportNameValue
        rs.Update
    End If

    ' إغلاق مجموعة السجلات
    rs.Close
    Set rs = Nothing
    Set db = Nothing

    MsgBox "تمت الإضافة بنجاح!", vbInformation

    Exit Sub

ErrorHandler:
    MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical
    If Not rs Is Nothing Then
        rs.Close
        Set rs = Nothing
    End If
    If Not db Is Nothing Then
        Set db = Nothing
    End If
End Sub

 

رابط هذا التعليق
شارك
M.Abd Allah

M.Abd Allah

قام بنشر
قام بنشر
10 ساعات مضت, safaa salem5 said:

نفس الكلام بيعمل اتنين سجل بالشكل دا

Screenshot_8.png

جربي الكود ده إن شاءالله هيظبط معاكي 

    On Error GoTo ErrorHandler
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim fixedNameValue As String
    Dim newResultValue As String
    Dim fixedDefaultValue As Variant
    Dim fixedNormalValue As Variant
    Dim reportNameValue As Variant
    Dim sql As String
    Dim MAXCODE As Long
    
    ' الحصول على القيم من الحقول
    fixedNameValue = Me.testnameN
    newResultValue = Me.Newresult
    fixedDefaultValue = Me.fixeddefault
    fixedNormalValue = Me.fixednormal
    reportNameValue = Me.Reportname
    
    ' التحقق من أن الحقول الثلاثة ليست فارغة
    If IsNull(fixedDefaultValue) Or IsNull(fixedNormalValue) Or IsNull(reportNameValue) Then
        MsgBox "يرجى استكمال باقي البيانات (fixeddefault, fixednormal, Reportname) قبل الإضافة.", vbExclamation
        Exit Sub
    End If
    
    ' التحقق من أن القيم ليست فارغة
    If IsNull(fixedNameValue) Or IsNull(newResultValue) Then
        MsgBox "يرجى ملء جميع الحقول قبل الإضافة ثم الضغط على الزرار", vbExclamation
        Exit Sub
    End If
    
    ' فتح قاعدة البيانات
    Set db = CurrentDb
    
    ' التحقق من عدم تكرار السجل في fixedresults_tbl
    sql = "SELECT COUNT(*) AS RecordCount FROM fixedresults_tbl WHERE Fixedname = '" & fixedNameValue & "' AND Fixedresult = '" & newResultValue & "'"
    Set rs = db.OpenRecordset(sql)
    
    If Not rs.EOF And rs!RecordCount > 0 Then
        MsgBox "القيمة المدخلة موجودة مسبقاً.", vbExclamation
        rs.Close
        Set rs = Nothing
        Set db = Nothing
        Exit Sub
    End If
    
    rs.Close
    Set rs = Nothing
    
    ' الحصول على قيمة الكود الجديدة
    MAXCODE = Nz(DMax("code", "fixedresults_tbl"), 0)
    Me.code.Value = MAXCODE + 1
    
    ' إضافة السجل الجديد في fixedresults_tbl
    sql = "INSERT INTO fixedresults_tbl (code, Fixedname, Fixedresult) " & _
          "VALUES (" & Me.code.Value & ", '" & fixedNameValue & "', '" & newResultValue & "')"
    db.Execute sql, dbFailOnError
    ' فتح الجدول Fixed_tbl للتحقق من وجود السجل وتحديثه أو إضافته
    sql = "SELECT * FROM Fixed_tbl WHERE fixedname = '" & fixedNameValue & "'"
    Set rs = db.OpenRecordset(sql, dbOpenDynaset, dbSeeChanges)
    
    If rs.EOF Then
        rs.AddNew
        rs!fixedname = fixedNameValue
        rs!fixeddefault = fixedDefaultValue
        rs!fixednormal = fixedNormalValue
        rs!Reportname = reportNameValue
        rs.Update
    Else
        rs.Edit
        rs!fixeddefault = fixedDefaultValue
        rs!fixednormal = fixedNormalValue
        rs!Reportname = reportNameValue
        rs.Update
    End If
    
    rs.Close
    Set rs = Nothing
    Set db = Nothing
    ' تحديث القائمة وإعلام المستخدم
    Resultlist.Requery
    Newresult.Value = ""
    MsgBox "تمت الإضافة بنجاح!", vbInformation
    Exit Sub
ErrorHandler:
    MsgBox "حدث خطأ: " & Err.Description, vbCritical
    If Not rs Is Nothing Then
        rs.Close
        Set rs = Nothing
    End If
    If Not db Is Nothing Then
        Set db = Nothing
    End If

 

رابط هذا التعليق
شارك

من فضلك سجل دخول لتتمكن من التعليق

ستتمكن من اضافه تعليقات بعد التسجيل



سجل دخولك الان
 مشاركة
الذهاب الي قائمه المواضيع

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information

  I accept