تسجيل حدث لعملية الحذف للاستدلال

[Abdelaziz Osman]

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

لدي نموذج باسم  fm4 

اريد عند حذف أي سجل بالكامل بمحتوياته كلها من هذا النموذج

يقوم الاكسس بأخذ نسخة من محتويات حقل واحد فقط من السجل اسم الحقل t4

يضعها في حقل اخر باسم oldrec هذا الحق داخل جدول باسم hestable  

مع تسجيل كل من الاتي داخل الجدول hestable  

-          اسم اليوزر القائم بالحذف.

-          اسم الكمبيوتر.

-          التاريخ الحالي تاريخ الحذف.

ويوجد بالجدول hestable   ثلاث حقول من الممكن استخدامهم في تسجيل  تلك الثلاث حقول أسمائهم كالتالي

-          User

-          Comname

-          curdata

[Foksh]

أين المرفق الذي تريد التعديل عليه 😅 ؟؟؟

 

مع أن الأمر هيّن إن شاء الله 

[kkhalifa1960]

ضع هذا الكود داخل حدث BeforeDelConfirm أو Delete في نموذج fm4 حسب ما يناسبك. الأفضل استخدام BeforeDelConfirm لأنه يسبق الحذف ويمنحك فرصة التسجيل قبل الإزالة.

📌 الخطوات:

1. افتح النموذج fm4 في وضع التصميم.

2. اضغط على النموذج نفسه (وليس عنصر داخل النموذج).

3. من نافذة الخصائص، اختر الحدث BeforeDelConfirm.

4. اضغط على زر "..." واختر "منشئ الكود".

5. الصق الكود التالي:

   Private Sub Form_BeforeDelConfirm(Cancel As Integer, Response As Integer)
       Dim db As DAO.Database
       Dim rs As DAO.Recordset
       Dim strT4 As String
       Dim strUser As String
       Dim strComName As String
       Dim dtNow As Date
       Dim userChoice As VbMsgBoxResult
   
       ' عرض رسالة تأكيد
       userChoice = MsgBox("هل أنت متأكد أنك تريد حذف هذا السجل؟", vbYesNo + vbQuestion, "تأكيد الحذف")
   
       If userChoice = vbNo Then
           ' إلغاء الحذف
           Cancel = True
           Response = acDeleteCancel
           Exit Sub
       End If
   
       ' استخراج البيانات من السجل الحالي
       strT4 = Nz(Me.t4, "")
       strUser = Environ("Username")
       strComName = Environ("Computername")
       dtNow = Now
   
       ' فتح الجدول وإضافة سجل جديد
       Set db = CurrentDb
       Set rs = db.OpenRecordset("hestable", dbOpenDynaset)
   
       rs.AddNew
       rs!oldrec = strT4
       rs!User = strUser
       rs!Comname = strComName
       rs!curdata = dtNow
       rs.Update
   
       rs.Close
       Set rs = Nothing
       Set db = Nothing
   
       ' السماح بالحذف
       Response = acDeleteOK
   End Sub

   💡 ملاحظات مهمة

   • تأكد أن الحقول التالية موجودة في جدول hestable:

     • oldrec (نص)

     • User (نص)

     • Comname (نص)

     • curdata (تاريخ/وقت)

   • الكود يستخدم Environ("Username") و Environ("Computername") للحصول على اسم المستخدم واسم الجهاز.

   • إذا أردت منع الحذف في حالات معينة (مثلاً إذا كان t4 فارغًا)، يمكن تعديل الكود لإلغاء الحذف عبر:

     Cancel = True
     Response = acDeleteCancel

      

تم تعديل منذ 23 ساعات بواسطه kkhalifa1960

[Foksh]

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

يبدو أنك تريد نقل الأفكار إلى مشروعك مباشرةً .. صحيح ؟؟

طيب ، ومشاركةً مع الأستاذ @kkhalifa1960 ، هذه فكرة أخرى من خلال زر الحذف نفسه . حيث استعملت الفكرة التالية في الزر فقط :-

Private Sub Btn_Del_Click()

    Dim Response As VbMsgBoxResult
    Dim t4Value As Variant
    Dim userName As String
    Dim computerName As String
    Dim sql As String

    Response = MsgBox("هل أنت متأكد أنك تريد حذف هذا السجل؟", vbYesNo + vbQuestion + vbMsgBoxRight, "")

    If Response = vbYes Then
        If IsNull(Me.T4) Or Me.T4 = "" Then
            MsgBox "لا يمكن تسجيل الحذف لأن الحقل T4 فارغ", vbExclamation + vbMsgBoxRight, ""
            Exit Sub
        End If

        t4Value = Me.T4
        userName = Environ("Username")
        computerName = Environ("ComputerName")

        sql = "INSERT INTO hestable (oldrec, [User], Comname, curdata) " & _
              "VALUES ('" & Replace(t4Value, "'", "''") & "', '" & Replace(userName, "'", "''") & "', '" & Replace(computerName, "'", "''") & "', Now());"

        On Error GoTo ErrHandler
        CurrentDb.Execute sql, dbFailOnError
        
        DoCmd.SetWarnings False
            DoCmd.RunCommand acCmdDeleteRecord
        DoCmd.SetWarnings True
            
    Else
        MsgBox "تم إلغاء عملية الحذف", vbInformation + vbMsgBoxRight, ""
    End If

    Exit Sub

ErrHandler:
    MsgBox "حدث خطأ أثناء تسجيل الحذف", vbCritical + vbMsgBoxRight, "خطأ"

End Sub

 

 

 

TrackDelete.zip

[Abdelaziz Osman]

بالغ التحية والتقدير والاحترام   لكما  معلمينا الافاضل  @kkhalifa1960 &   @Foksh

[Abdelaziz Osman]

لكن كلما استخدمت  كلى الاكواد  يعطينى رسالة ان الحقل t4 فارغ ولا يقوم بنسخ محتوى الحقل t4

فما العمل    @kkhalifa1960 &   @Foksh

[Foksh]

 

الخلل في طريقة تنفيذك ونقلك للفكرة . ما لم تقم بارفاق ملفك

مع العلم انك قمت باختيار الاجابة ... فكيف هذا !!!!

[Abdelaziz Osman]

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

لك جزيل الشكر

[Foksh]

1 دقيقه مضت, Abdelaziz Osman said:

هل من الممكن اضافة سطر داخل الكود يقوم بنسخ محتويات t4 اولا

دلالة على انك لم تقرأ الكود وتتفحصه اخي الكريم ..

لاحظ الجزء التالي :-

        t4Value = Me.T4
        userName = Environ("Username")
        computerName = Environ("ComputerName")

        sql = "INSERT INTO hestable (oldrec, [User], Comname, curdata) " & _
              "VALUES ('" & Replace(t4Value, "'", "''") & "', '" & Replace(userName, "'", "''") & "', '" & Replace(computerName, "'", "''") & "', Now());"

        On Error GoTo ErrHandler
        CurrentDb.Execute sql, dbFailOnError

جملة تنفيذ استعلام اضافة داخل الجدول أولا . ثم :-

        DoCmd.SetWarnings False
            DoCmd.RunCommand acCmdDeleteRecord
        DoCmd.SetWarnings True

جملة حذف السجل ثانياً 

[Abdelaziz Osman]

6 دقائق مضت, Foksh said:

دلالة على انك لم تقرأ الكود وتتفحصه اخي الكريم ..

لاحظ الجزء التالي :-

        t4Value = Me.T4
        userName = Environ("Username")
        computerName = Environ("ComputerName")

        sql = "INSERT INTO hestable (oldrec, [User], Comname, curdata) " & _
              "VALUES ('" & Replace(t4Value, "'", "''") & "', '" & Replace(userName, "'", "''") & "', '" & Replace(computerName, "'", "''") & "', Now());"

        On Error GoTo ErrHandler
        CurrentDb.Execute sql, dbFailOnError

جملة تنفيذ استعلام اضافة داخل الجدول أولا . ثم :-

        DoCmd.SetWarnings False
            DoCmd.RunCommand acCmdDeleteRecord
        DoCmd.SetWarnings True

جملة حذف السجل ثانياً 

اسمح لى  اعد لك نموذج مصغر من مشروعى وارسله اليك لكي تختبرة بنفسك   وقد قرات الكود بالفعل اكثر من مرة ولكن يوجد لدي مشروع شئ اخر لا اعرفه اسمح لى ارجع لك مرة اخرى  ولكن اسمح لى ان استخدم كود حدث قبل الحذف

الذي اعده اخونا الكريم @kkhalifa1960

تم تعديل منذ 2 ساعات بواسطه Abdelaziz Osman

[Abdelaziz Osman]

منذ ساعه, Foksh said:

دلالة على انك لم تقرأ الكود وتتفحصه اخي الكريم ..

لاحظ الجزء التالي :-

        t4Value = Me.T4
        userName = Environ("Username")
        computerName = Environ("ComputerName")

        sql = "INSERT INTO hestable (oldrec, [User], Comname, curdata) " & _
              "VALUES ('" & Replace(t4Value, "'", "''") & "', '" & Replace(userName, "'", "''") & "', '" & Replace(computerName, "'", "''") & "', Now());"

        On Error GoTo ErrHandler
        CurrentDb.Execute sql, dbFailOnError

جملة تنفيذ استعلام اضافة داخل الجدول أولا . ثم :-

        DoCmd.SetWarnings False
            DoCmd.RunCommand acCmdDeleteRecord
        DoCmd.SetWarnings True

جملة حذف السجل ثانياً 

مرفق سيدى الملف والفكرة انه عند فتح النموذج يوجد عامل تصفية يرجى عدم الغاء فكرة عامل التصفية  افتح على سبيل المثال السجل رقم 2798/2023

وقم بحذفه سوف يعطى رسالة انه لم يستخرج قيمة من الحقل T4  مسبقا لانه على حد علمى ياخذ القيمة بعد الحذف 

ارجو عدم الغاء عامل التصفية لانه مهم فى مشروعى

FMK.accdb

[Foksh]

هذا ليس الكود الذي ارفقته لك بدايةً ..

ثم أنه لا بد من أن تقوم بالتفريق بين حقل وعنصر مربع نص

الحقل أحد مكونات الجدول . أما العنصر T4 الذي تقصده فهو مربع نص مصدره في جدوله = الحقل TENDER_NO

 

شكراً لك ..

[Abdelaziz Osman]

1 دقيقه مضت, Foksh said:

هذا ليس الكود الذي ارفقته لك بدايةً ..

ثم أنه لا بد من أن تقوم بالتفريق بين حقل وعنصر مربع نص

الحقل أحد مكونات الجدول . أما العنصر T4 الذي تقصده فهو مربع نص مصدره في جدوله = الحقل TENDER_NO

 

شكراً لك ..

نعم سيدي تعليقك صحيح  ولكنى جربت ان اغير الاسم من T4  الى TENDER_NO  , ولكن التغيير لم يستجيب ايضا