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

[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

      

تم تعديل منذ 2 ساعات بواسطه 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