تصحيح كود

[Foksh]

من الواضح انه يوجد لديك تكرار للكود الخاص بالزر أمر8 ، تأكد من عم وجود تكرار لحدث عند النقر لنفس الزر مرتين

قمت بالرد على الجزء الأول ، أما فيما يتعلق بالمشكلة التي تمر بها على القاعدة الأصلية ، فلا أعلم طبيعتها ولا كيفية نقلك للكود في تشابه أو اختلاف الأسماء ..... إلخ .

[أبو أحمد]

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

ن الواضح انه يوجد لديك تكرار للكود الخاص بالزر أمر8 ، تأكد من عم وجود تكرار لحدث عند النقر لنفس الزر مرتين

بالفعل عند الضغط مرتين تم تنفيذ المطلوب بدون اعطاء الرسالة 

ولكن السؤال الآن أن مش فاهم من أين التكرر 
حضرتك تقصد أنني كررت الكود مع زر أمر في نموذج آخر ؟ مثلا 

[Foksh]

الان, أبو أحمد said:

حضرتك تقصد أنني كررت الكود مع زر أمر في نموذج آخر ؟ مثلا 

في نفس النموذج أخي :-

1. الموضع الأول :-

   Private Sub أمر8_Click()
   Public Function arTableName() As String
       arTableName = ChrW(1580) & ChrW(1583) & ChrW(1608) & ChrW(1604) & ChrW(32) & _
                       ChrW(1578) & ChrW(1587) & ChrW(1580) & ChrW(1610) & ChrW(1604) & ChrW(32) & _
                       ChrW(1575) & ChrW(1604) & ChrW(1603) & ChrW(1578) & ChrW(1576)
   End Function

2. الموضع الثاني :-

   Private Sub أمر8_Click()
       Dim arTblName       As String
       Dim maxGN           As Long
       Dim arMsgPrompt     As String
       Dim arMsgTitle      As String
       Dim msgResponse     As VbMsgBoxResult
       
       On Error GoTo ErrorHandler
       
       arTblName = arTableName
       maxGN = Nz(DMax("[No_Gard]", "[T_Gard]"), 0)
       arMsgTitle = "تأكيد تنفيذ الأمر"
       arMsgPrompt = "أنت على وشك تحديث حالة جميع الكتب  باليومية"
       arMsgPrompt = arMsgPrompt & vbCrLf & "من كتب موجودة إلى كتب فاقد"
       arMsgPrompt = arMsgPrompt & vbCrLf & "لتأكيد الأمر أضغط موافق ، ولإلغائه أضغط إلغاء"
       msgResponse = MsgBox(arMsgPrompt, vbQuestion + vbOKCancel + vbMsgBoxRight, arMsgTitle)
   
       strSQL = "UPDATE [" & arTblName & "]" & vbCrLf & _
                   " SET [" & arTblName & "].CaseBook = ""فاقد""," & vbCrLf & _
                   " [" & arTblName & "].[G N] = " & maxGN & vbCrLf & _
                   " WHERE ((([" & arTblName & "].CaseBook)=""موجود"")" & vbCrLf & _
                   " AND (Not ([" & arTblName & "].title) Is Null)" & vbCrLf & _
                   " AND (([" & arTblName & "].searinumber) Between [forms]![F_GardBooks]![text]" & vbCrLf & _
                   " AND [forms]![F_GardBooks]![text2]))" & vbCrLf & _
                   " OR ((([" & arTblName & "].CaseBook)=""موجود"")" & vbCrLf & _
                   " AND (([" & arTblName & "].title) Is Null)" & vbCrLf & _
                   " AND (([" & arTblName & "].searinumber) Between [forms]![F_GardBooks]![text]" & vbCrLf & _
                   " AND [forms]![F_GardBooks]![text2]));"
       
       If msgResponse = vbOK Then
           DoCmd.SetWarnings False
           DoCmd.RunSQL strSQL
           DoCmd.SetWarnings True
           MsgBox "تم تحديث البيانات بنجاح والحمد لله"
       Else
       
       End If
       
       Exit Sub
       
   ErrorHandler:
       Debug.Print Err.Number; Err.Description
   End Sub

 

[أبو أحمد]

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

في نفس النموذج أخي :-

أستاذي الكريم 
أنا لم أضع في زر الأمر إلا حدث واحد فقط وهو عند النقر 

Private Sub أمر136_Click()
    UpdateBooksToLost
End Sub

Public Sub UpdateBooksToLost()
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim maxGard As Long

    Set db = CurrentDb

    maxGard = Nz(DMax("No_Gard", "T_Gard"), 0)

    Set rs = db.OpenRecordset("SELECT * FROM [جدول تسجيل الكتب] WHERE [CaseBook] = 'موجود'", dbOpenDynaset)

    If Not rs.EOF Then
        rs.MoveFirst
        Do While Not rs.EOF
            rs.Edit
            rs!CaseBook = "فاقد"
            rs![G N] = maxGard
            rs.Update
            rs.MoveNext
        Loop
    End If

    rs.Close
    Set rs = Nothing
    Set db = Nothing

    MsgBox "تم تحديث الكتب إلى الحالة 'فاقد' بنجاح", vbInformation + vbMsgBoxRight, ""
End Sub
 

[Foksh]

أثابك الله ، راجع ملفك الأخير في هذه المشاركة :-

 

 

 

[أبو أحمد]

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

ثابك الله ، راجع ملفك الأخير في هذه المشاركة :-

أستاذي الكريم 
والله هو كان قد أرسل لي رد سابقا ولم أنتبه إليه الإ الان فأردت أن أوضح له أنه يوجد مشكلة في الكود الذي أرسله لي فقط 

من باب أنني اهتمت بردكم فقط 

وجزاكم الله خيرا لكما ولكن كان واجب أن أريد على رده لي فقط 

[Foksh]

ليس هناك من مشكلة أخي الكريم ، انا وجهتك الى الخطأ الحاصل في الملف والغير مقصود لربما ..

ويبدو أنك قمت بتعديل المشاركة المشار اليها سابقاً ولم أنتبه لها ..

 

جزاكم الله كل خير على متابعتكم  

[أبو أحمد]

1 ساعه مضت, Foksh said:

قمت بالرد على الجزء الأول ، أما فيما يتعلق بالمشكلة التي تمر بها على القاعدة الأصلية

أستاذي الكريم جزاكم الله خيرا على سعة صدركم والرد علي طلبي 

ولكن عندما وضعت في أول الكود  
On Error Resume Next

لم تظهر المشكلة وتم تحديث البيانات المطلوبة تماما ولكن الشي الغريب أنه لم تظهر رسالة "تم تحديث البيانات بنجاح عموما ليست ضرورية وجزاكم الله خيرا وزادكم علما وسعة صدر

أقصد هكذا جعلتها

Private Sub أمر136_Click()
On Error Resume Next
    UpdateBooksToLost
End Sub