كود الحذف لايعمل

[husseinharby]

السلام عليكم

في  نموذج sale

في هذا المثال عندما اقوم بالاضافة او التعديل يتم ارسال البيانات الي جدول revesion

لكن الحذف لايعمل

عندما اقوم بحذف صف من النموذج الفرعي لا يظهر الحذف في جدول revesion

 

copy (1).rar

[ابوآمنة]

تفضل

أضفنا أمر DELETE في الوحدة النمطية 

ووضعنا الأمر عند الحدث في النموذج .

 

copy.accdb

تم تعديل مارس 29, 2020 بواسطه ابوآمنة

[husseinharby]

شكرا استاذ صالح

الكود شغال تمام 

لكن تظهر رسالة خطأ عند التسجيل

[ابوآمنة]

تفضل 

واخبرني بالنتائج 

copy.zip

[husseinharby]

شكرا استاذ صالح ممكن حضرتك توضح لي ماذا قمت بتعديله

لكي اقوم بتطبيقه علي القاعدة الاصلية لدي

[ابوآمنة]

انقل الكود فقط

تم تعطيل رسالة الخطأ فقط

[husseinharby]

شكرا استاذ صالح

[أبوبسمله]

احسنت اخى واستاذى صالح @ابوآمنة جزاك الله خيرا

اخى حسين @husseinharby لاتنسى بارك الله فيك👇

ولما تحصل على اجابة لسؤال موضوعك ، فرجاء اختيار افضل اجابة ، هكذا (حتى مستقبلا يسهل معرفة الاجابة الصحيحة) :

.

شكرا 🙂

[husseinharby]

عذرا استاذ صالح 

خطأ بالكود يظهر لي

[أبوبسمله]

اخى الفاضل @husseinharby

لقد قمت المرفق الاخير لاهى صالح ويعمل عندى بكفائه فى التعديل والاضافه والحذف

متى يظهر هذا الخطأ عندك ؟

[ابوآمنة]

48 دقائق مضت, husseinharby said:

عذرا استاذ صالح 

خطأ بالكود يظهر لي

الكود بعد  وضع كود تجاوز الخطأ

جرب الآن

Sub AuditChanges(IDField As String, UserAction As String, UsedForm As Form)
  'كود تجاز الخطاء
   ' 
   On Error Resume Next
    Dim cnn As ADODB.Connection
    Dim rst As ADODB.Recordset
    Dim ctl As Control
    Dim datTimeCheck As Date
    Dim strUserID As String
    Set cnn = CurrentProject.Connection
    Set rst = New ADODB.Recordset
    rst.Open "SELECT * FROM revision", cnn, adOpenDynamic, adLockOptimistic
    datTimeCheck = Now()
    strUserID = Environ("USERNAME")
    
    Select Case UserAction
        Case "EDIT"
            For Each ctl In UsedForm.Controls
                If ctl.Tag = "Audit" Then
                    If Nz(ctl.Value) <> Nz(ctl.OldValue) Then
                        With rst
                            .AddNew
                            ![DateTime] = datTimeCheck
                            ![UserName] = strUserID
                            ![FormName] = UsedForm.name
                            ![Action] = UserAction
                            ![RecordID] = UsedForm.Controls(IDField).Value
                            ![FieldName] = ctl.ControlSource
                            ![OldValue] = ctl.OldValue
                            ![NewValue] = ctl.Value
                            .Update
                        End With
                    End If
                End If
            Next ctl
            
        Case "DELETE"
            For Each ctl In UsedForm.Controls
                If ctl.Tag = "Audit" Then

                        With rst
                            .AddNew
                            ![DateTime] = datTimeCheck
                            ![UserName] = strUserID
                            ![FormName] = UsedForm.name
                            ![Action] = UserAction
                            ![RecordID] = UsedForm.Controls(IDField).Value
                            ![FieldName] = ctl.ControlSource
                            ![OldValue] = ctl.Value
                            .Update
                        End With
                End If
            Next ctl

          Case Else
         For Each ctl In UsedForm.Controls
                 If ctl.Tag = "Audit" Then
                    If Nz(ctl.Value) <> Nz(ctl.OldValue) Then
            With rst
                .AddNew
                ![DateTime] = datTimeCheck
                ![UserName] = strUserID
                ![FormName] = UsedForm.name
                ![Action] = UserAction
                ![RecordID] = UsedForm.Controls(IDField).Value
                ![FieldName] = ctl.ControlSource
                ![NewValue] = ctl.Value
                .Update
            End With
          End If
      End If
             Next ctl
    End Select
    rst.Close
    cnn.Close
    Set rst = Nothing
    Set cnn = Nothing
    Exit Sub

End Sub

 

تم تعديل مارس 29, 2020 بواسطه ابوآمنة

[husseinharby]

شكرا استاذ صالح

تم حل المشكلة

[ابوآمنة]

الحمدلله 

[husseinharby]

@احمد الفلاحجي

شكرا استاذ احمد علي اهتمامك 

تم حل المشكلة من قبل اخينا الكريم استاذ صالح

@ابوآمنة

حاجة بسيطة يا استاذ صالح

تم تعديل مارس 29, 2020 بواسطه husseinharby