jjafferr

سيدي الفاضل ابو عبدالله عندك مشكلتين: 1. في الاستعلام usys_account ، عندك كلمة usys مكررة مرتين ، وهذا خطأ مطبعي ، 2. ولكن المشكلة الاكبر والتي لا يعرفها الكثير من المبرمجين ، وهو عدم استعمال علامة "ناقص" في مسميات كائنات الاكسس (لاحظ اسم الجدول usys-invoicesale ) ، واذا اردت استعمالها كلٌ ولابد ، فيجب ان تضع هذا المسمى بين قوسين مربعين في الكود ، هكذا: [usys-invoicesale] جعفر

وعليكم السلام اذا كان اسم الحقل: A ، فغيّره الى A1 مثلا ، ونفترض ان مصدر الحقل هو A كذلك ، فغيّره الى: =nz([A];0) جعفر

وعليكم السلام في النموذج TestF نضيف الحدث على التحميل ، و وحدة نمطية لحساب عدد الحقول: Function Count_Fields() Dim rst As DAO.Recordset 'Set rst = Forms!main!Datamasterform!TestF.Form.RecordsetClone Set rst = Me.RecordsetClone rst.MoveLast: rst.MoveFirst: RC = rst.RecordCount K1 = 0: K2 = 0 For i = 1 To RC If rst!Country = "اسكندرية" Then K1 = K1 + 1 End If If rst![on or of] = -1 Then K2 = K2 + 1 End If rst.MoveNext Next i Me.Count_Esk = K1 Me.Count_True = K2 Me.Count_False = RC - K2 End Function Private Sub Form_Load() Call Count_Fields End Sub . وعند الضغط على زر التصفية ، ننادي الوحدة النمطية اعلاه: Call Form_TestF.Count_Fields جعفر 660.2.Test2006.mdb.zip

انا لم انزل مرفقك ، فالكود السابق لم يكن يعمل على المادة اصلا !! جرب الكود التالي Private Sub Form_BeforeUpdate(Cancel As Integer) On Error GoTo err_chk_BeforeUpdate Dim ctl As Control Dim rst As DAO.Recordset Dim dbs As DAO.Database Dim fName As String: Dim myCriteria As String Dim A0 As String: Dim A1 As String: Dim A2 As String If Left(Me.ActiveControl.Name, Len("TextBox")) <> "Textbox" Then Set ctl = Me.ActiveControl Else Set ctl = ctlDrop End If 'fName = "[" & Mid(ctl.Name, 1, Len(ctl.Name) - 1) & "-مادة" & Right(ctl.Name, 1) & "]" '[الاثنين-مادة1] fName = "[" & Mid(ctl.Name, 1, Len(ctl.Name) - 1) & Right(ctl.Name, 1) & "]" myCriteria = "[" & ctl.Name & "]=" & Chr(39) & ctl.Value & Chr(39) Debug.Print "Select * From [Teacher Class] Where " & myCriteria 'A0 = DLookup(ctl.Name, "Teacher Class", myCriteria) 'A1 = DLookup(fName, "Teacher Class", myCriteria) 'A2 = DLookup("[NAMEe]", "Teacher Class", myCriteria) Set dbs = CurrentDb Set rst = dbs.OpenRecordset("Select * From [Teacher Class] Where " & myCriteria) A0 = rst(ctl.Name) A1 = rst(fName) A2 = rst!NAMEe ' If A0 > 0 Then Beep If MsgBox("...هذا الفصل " & ctl.Name & "..لديه مادة.." & vbCrLf & _ " باسم : " & A1 & vbCrLf & _ " للمدرس : " & A2, _ vbYesNo + vbCritical + vbMsgBoxRight, "تنبيه") = vbNo Then Me.Undo Cancel = True End If ' End If Exit_chk_BeforeUpdate: rst.Close: Set rst = Nothing: dbs.Close Exit Sub err_chk_BeforeUpdate: If err.Number = 3021 Then Resume Next Else MsgBox err.Number & vbCrLf & err.Description End If End Sub واستخدم الطريقة اللي اخبرت في الصورة في مشاركتي السابقة ، على بقية حقول المادة في النموذج ايضا. جعفر

وعليكم السلام بما انك عملت تغيير في الكود الاصل ، واللي كان تابع لحدث "قبل التحديث" الحقول ، فيجب ان نُرجع الكود ، بحيث انه يخاطب كود "قبل تحديث النموذج" ، وبدل ان اضيف الكود لكل حقل ، اعمل التالي: اختار الحقول التي يجب على البرنامج يتأكد منها (كما في الصورة ادناه) ، ثم في الحدث "قبل التحديث" لهذه الحقول ، ننادي الوحدة النمطية chk_BeforeUpdate (رجاء كتابة اسم الوحدة النمطية كما تراها في الصورة ادناه) ، هكذا : . وعليه ، فيجب علينا إضافة الوحدة النمطية الجديدة ، وعمل تعديل بسيط على الكود الاصل ، ليصبحا هكذا : Function chk_BeforeUpdate() Call Form_BeforeUpdate(0) End Function Private Sub Form_BeforeUpdate(Cancel As Integer) On Error GoTo err_chk_BeforeUpdate Dim ctl As Control Dim rst As DAO.Recordset Dim dbs As DAO.Database Dim fName As String: Dim myCriteria As String Dim A0 As String: Dim A1 As String: Dim A2 As String If Left(Me.ActiveControl.Name, Len("TextBox")) <> "Textbox" Then Set ctl = Me.ActiveControl Else Set ctl = ctlDrop End If fName = "[" & Mid(ctl.Name, 1, Len(ctl.Name) - 1) & "-مادة" & Right(ctl.Name, 1) & "]" '[الاثنين-مادة1] myCriteria = "[" & ctl.Name & "]=" & Chr(39) & ctl.Value & Chr(39) 'A0 = DLookup(ctl.Name, "Teacher Class", myCriteria) 'A1 = DLookup(fName, "Teacher Class", myCriteria) 'A2 = DLookup("[NAMEe]", "Teacher Class", myCriteria) Set dbs = CurrentDb Set rst = dbs.OpenRecordset("Select * From [Teacher Class] Where " & myCriteria) A0 = rst(ctl.Name) A1 = rst(fName) A2 = rst!NAMEe ' If A0 > 0 Then Beep If MsgBox("...هذا الفصل " & ctl.Name & "..لديه مادة.." & vbCrLf & _ " باسم : " & A1 & vbCrLf & _ " للمدرس : " & A2, _ vbYesNo + vbCritical + vbMsgBoxRight, "تنبيه") = vbNo Then Me.Undo Cancel = True End If ' End If Exit_chk_BeforeUpdate: rst.Close: Set rst = Nothing: dbs.Close Exit Sub err_chk_BeforeUpdate: If err.Number = 3021 Then Resume Next Else MsgBox err.Number & vbCrLf & err.Description End If End Sub . اما بالنسبة الى رسائل الخطأ التي تكلمت عنها ، فلا علم لي بها , ولم تظهر لي. جعفر جدول الحصص.zip

السلام عليكم المرفقات اللي ارسلتها لك في مشاركاتي السابقة ، جميعها تشتغل في وضع التصميم ، بإستخدام اكسس 2010 ، ولا اعرف ماهي مشكلتك !! وكمحاولة اخيرة ، ارفق لك ملف مضغوط ، فيه 3 ملفات txt : j_BarStudentPayment.txt j_BarUserSummary.txt j_PaymentEach22.txt كل ملف عبارة عن نموذج من نماذجك الثلاث: BarUserSummary ، BarStudentPayment ، PaymentEach22 ولتحويل هذه الملفات الى نماذج في الاكسس : 1. افتح برنامجك في الاكسس ، 2. احذف هذه النماذج المعطوبة (BarUserSummary ، BarStudentPayment ، PaymentEach22) من برنامجك ، 3. فك الملفات الثلاث من الملف المضغوط المرفق ، واجعل الملفات في نفس مجلد برنامجك ، 4. اعمل وحدة نمطية جديدة في برنامجك ، والصق هذا الكود فيها: Function SaveAsText() Dim File_Path As String File_Path = Application.CurrentProject.Path 'Save the Forms as txt files ' Application.SaveAsText acForm, "PaymentEach22", File_Path & "\j_PaymentEach22.txt" ' Application.SaveAsText acForm, "BarUserSummary", File_Path & "\j_BarUserSummary.txt" ' Application.SaveAsText acForm, "BarStudentPayment", File_Path & "\j_BarStudentPayment.txt" 'Load the Forms from txt files Application.LoadFromText acForm, "PaymentEach22", File_Path & "\j_PaymentEach22.txt" Application.LoadFromText acForm, "BarUserSummary", File_Path & "\j_BarUserSummary.txt" Application.LoadFromText acForm, "BarStudentPayment", File_Path & "\j_BarStudentPayment.txt" MsgBox "done" End Function . 5. قم بتشغيل/منادات هذه الوحدة النمطية ، 6. عند انتهاء الكود من عمله ، ستحصل على رسالة "done" ، 7. سترى هذه النماذج في برنامجك ، وستستطيع فتحها في وضع التصميم ان شاء الله جعفر LoadFromText.zip

ممكن ترفق هذه الجزئية من برنامجك لوسمحت جعفر

تمام والآن ، علشان تخفي الحقول الغير مطلوبة ، وتمدد/تقلص حجم الحقول ، شوف هذا الرابط جعفر

الفكرة هي الرجوع للاستعلام ، وعمل كل شيء هناك: ولكن لفهم الاكواد في التقرير ، كان يجب تحليلها: . وضعنا الكود في الاستعلام ، ولذي سيزيد وينقص عدد السجلات حسب عدد لفصول : . وعملنا تقرير فرعي من الاستعلام اعلاه ، ووضعناه داخل التقرير الرئيسي: . جعفر mezanya.zip

يجب ان يكون الاسمين مختلفين

تفضل SQL = "SELECT id, nam, d" SQL=SQL & " FROM جدول1" SQL=SQL & " Where d=#" & Date() & "#" SQL=SQL & " ORDER BY id" جعفر

وعليكم السلام نعمل وحدة نمطية اسمها C_Word : function C_Word(T as string) as string T=Replace(T,"مصطفي","مصطفى") T=Replace(T,"يحيي","يحيى") T=Replace(T,"مجدي","مجدى") T=Replace(T,"عبد الحميد","عبدالحميد") T=Replace(T,"محمداحمد","محمد احمد") C_Word=T end function وتناديها (على افتراض ان اسم الحقل الذي به المعلومة للتصحيح هو test) : من الاستعلام A:C_Word([test]) من النموذج او التقرير =C_Word([test]) جعفر

وعليكم السلام النموذجين يشتغلون بدون مشاكل ، وكان ينقصهم النموذج PaymentEach22 اللي اضفته من المشاركة السابقة ، الاستعلام Cod_Sanction غير موجود ، والنموذج PaymentEach22 محتاج اليه. كذلك ، ما ادري ايش طلبك !! جعفر db3.zip

تفضل هذا الرابط https://www.officena.net/ib/topic/80802-عرض-التقرير-بشكل-افقي/ جعفر

وعليكم السلام تفضل الكود: https://access-programmers.co.uk/forums/showpost.php?p=994044&amp;postcount=1 جعفر

انا لم افهم قصدك بالضبط !! ولكن اذا فهمي كان هو التحكم في عدد الحقول (وليس السجلات) ، فتستطيع ان تعطي المربعات تسلسل ابتداء من الفصل الاول للعاشر ، مثلا: Class_01 ، Class_02 ، ... Class_10 وتجعل هذا الحدث على "حدث تنسيق" قسم الـ Detail في التقرير: طبعا هذا الكود مجرد اسطر تم كتابتها فقط لمعرفة كيف كتابة الكود ، ولكنها غير مكتوبة بأي تنسيق/تخطيط dim ctl as dao.control counter=0 For Each ctl In me.controls if ctl.controltype=actextbox then counter=counter+1 if "...The Number of controls..." then ctl("Class_" & format(Counter,"00")).width=0 ctl("Class_" & format(Counter,"00")).visible=false else ctl("Class_" & format(Counter,"00")).width=1 * 1440 '1 inch ctl("Class_" & format(Counter,"00")).visible=true endif endif Next ctl جعفر

وعليكم السلام اخي حمدي ، 1. نت غيرت حدث "قبل التحديث" ، بدل ان يكون للحقول ، جعلته للنموذج ، والعمل اختلف كليا !! 2. وحدة الافلات هي التي كانت المشكلة ، وليس الكود الذي اعطيتك ، 3. انت نسيت ان تنسخ سطر Exit Sub للكود !! على العموم ، تفضل: Private Sub Form_BeforeUpdate(Cancel As Integer) On Error GoTo err_chk_BeforeUpdate Dim ctl As Control Dim rst As DAO.Recordset Dim dbs As DAO.Database Dim fName As String: Dim myCriteria As String Dim A0 As String: Dim A1 As String: Dim A2 As String 'Set ctl = Me.ActiveControl Set ctl = ctlDrop fName = "[" & Mid(ctl.Name, 1, Len(ctl.Name) - 1) & "-مادة" & Right(ctl.Name, 1) & "]" '[الاثنين-مادة1] myCriteria = "[" & ctl.Name & "]=" & Chr(39) & ctl.Value & Chr(39) 'A0 = DLookup(ctl.Name, "Teacher Class", myCriteria) 'A1 = DLookup(fName, "Teacher Class", myCriteria) 'A2 = DLookup("[NAMEe]", "Teacher Class", myCriteria) Set dbs = CurrentDb Set rst = dbs.OpenRecordset("Select * From [Teacher Class] Where " & myCriteria) A0 = rst(ctl.Name) A1 = rst(fName) A2 = rst!NAMEe ' If A0 > 0 Then Beep If MsgBox("...هذا الفصل " & ctl.Name & "..لديه مادة.." & vbCrLf & _ " باسم : " & A1 & vbCrLf & _ " للمدرس : " & A2, _ vbYesNo + vbCritical + vbMsgBoxRight, "تنبيه") = vbNo Then Me.Undo Cancel = True End If ' End If Exit_chk_BeforeUpdate: rst.Close: Set rst = Nothing: dbs.Close Exit Sub err_chk_BeforeUpdate: If err.Number = 3021 Then Resume Next Else MsgBox err.Number & vbCrLf & err.Description End If End Sub جعفر

عملنا انا وانت تقرير لطباعة الصف في صفحة واحدة ، سواء اكان هناك 30 او 50 طالب

وعليكم السلام لا تضيف حقل/حقول ، وانما اخفي الحقل/الحقول الاضافية و اجعل العرض = 0 (حتى لا ترى مسافة فاضية بين الحقول) ، يعني اعمل في التقرير 10 حقول بدل 4 (مثلا ، ولتفادي المشكلة مستقبلا) ، واجعل الكود يحسب عدد الحقول الموجوده في السنة ، وعليه يُظهر الحقول المطلوبة ، ويُخفي بقية الحقول جعفر

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

وعليكم السلام مرفقك فيه النموذج المعطوب ، ولا يوجد فيه النموذجين BarUserSummary ، BarStudentPayment !! فما ادري ايش طلبك !! جعفر

اما انا ، فاستعمل الطريقة التالية في برامجي ، واضع كل شيء في الماكرو autoexec ، واذا لم يصلك الخبر بعد ، فانا لا استعمل النماذج المنبثقة في برامجي ، إلا نادرا : وكلمة سر النموذج هو 1234 جعفر

وعليكم السلام اخي الفاضل ، قلت لك ان النموذج PaymentEach_OLD معطوب ، وقد نسخت لك جميع كائناته الى النموذج PaymentEach ، فإستعمله في برنامجك واحذف النموذج القديم جعفر

السلام عليكم ورحمة الله وبركاته بسبب وقتي الضيق هذه الايام ، فانا انزور المنتدى في الليل فقط البارحة اشتغلت على البرنامج ، ولكن جزئية بسيطة منه لم تشتغل ، فنظرت في البرنامج الليلة ، واذا بأخوي ابو خليل قد وضع اجابته فكنت سأتوقف عن العمل ، ولكن ملاحظته عن سرعة البرنامج لفت نظري ، واردت ان ارى اذا استطيع ان اتغلب على بطئ العملية ، واعتقد بأني بالفعل توفقت والحمدلله Option Compare Database 'Option Explicit Private Sub cmd_Go_Click() On Error GoTo err_cmd_Go_Click Dim dbs As DAO.Database Dim rst As DAO.Recordset Dim rstG As DAO.Recordset 'الغلاف Z = 1 Set dbs = CurrentDb Set rstG = dbs.OpenRecordset("SELECT Group FROM Students GROUP BY Group ORDER BY Group") rstG.MoveLast: rstG.MoveFirst RCg = rstG.RecordCount For k = 1 To RCg Set rst = dbs.OpenRecordset("Select * From Students Where [Group]=" & rstG!Group & " Order By Sery, Group") 'Set rst = dbs.OpenRecordset("Select * From Students Order By Sery, Group") rst.MoveLast: rst.MoveFirst RC = rst.RecordCount If RC / 50 = Int(RC / 50) Then Groups = RC / 50 Else Groups = Int(RC / 50) + 1 End If Counter = 0 For i = 1 To Groups For j = 1 To 50 Counter = Counter + 1 rst.Edit rst!kolaf = i rst.Update rst.MoveNext Next j 'rst.MoveNext Next i rstG.MoveNext Next k Start_mazroof: rstG.Close: Set rstG = Nothing 'الظرف Z = 2 Set rst = dbs.OpenRecordset("Select * From Students Order By Sery, Group") rst.MoveLast: rst.MoveFirst RC = rst.RecordCount If RC / 50 = Int(RC / 50) Then Groups = RC / 50 Else Groups = Int(RC / 50) + 1 End If For i = 1 To Groups For j = 1 To 50 rst.Edit rst!mazroof = i rst.Update rst.MoveNext Next j 'rst.MoveNext Next i Exit_cmd_Go_Click: rst.Close: Set rst = Nothing: dbs.Close MsgBox "Done" Exit Sub err_cmd_Go_Click: If Err.Number = 3021 And Z = 1 Then Resume Start_mazroof ElseIf Err.Number = 3021 And Z = 2 Then Resume Exit_cmd_Go_Click ElseIf Err.Number = 3052 Then Resume Else MsgBox Err.Number & vbCrLf & Err.Description End If End Sub جعفر رقم الغلاف والمظروف.zip