jjafferr

السلام عليكم المرفقات اللي ارسلتها لك في مشاركاتي السابقة ، جميعها تشتغل في وضع التصميم ، بإستخدام اكسس 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&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

وهي تجربتي 100% كذلك ، ولعدة اسباب فانا استعمل نوعين من الماكرو فقط ، ماكرو ليفتح عند فتح البرنامج ، ويجب ان يكون اسمه autoexec ، والماكرو الآخر هو لوقف اسخدام ازرار الكيبورد للدخول في الكود وقائمة كائنات البرنامج ، اما بقية برامجي فاستخدم VBA هذه ليست رموز ، انما لأنك كاتب اسم النموذج بالعربي (ونحن دائما نقول: يجب ان تكتب اسماء الكائنات جميعها بالانجليزية ، الجداول والنماذج والاستعلامات والتقارير والماكرو ، واسماء الحقول) ، فالبرنامج كتب ارقام الحروف بالـ ascii code ، ولم يستعمل الامر chr بسبب استعمالك للحروف العربية ، فإستخدم chrW ومن الرابط المرفق تحصل على ارقام الحروف العربية ، مثلا ChrW(1608) = و http://sites.psu.edu/symbolcodes/languages/mideast/arabic/arabicchart/ جعفر

وعليكم السلام النموذج معطوب ، فلا يمكنك الاستفادة منه ، لذا عملت لك نسخه من كائناته في نموذج جديد بإسم PaymentEach ، ولكن للعلم ، قد تكون احد كائنات النموذج هي السبب في جعل النموذج معطوب ، فالافضل ان تعمل النموذج من جديد!! استطعت/تستطيع فتح النموذج القديم هكذا: نموذجك اسمه PaymentEach_OLD ، لما تنقر عليه مرتين تحصل على هذه الرساله (انا عملت ماكرو بإسم تكبير والذي كان يطلبه البرنامج ،وطلبت منه يعطين هذه الرساله) : . سينفتح النموذج ، ثم انقر بالفأرة اليمين ، فتحصل على هذه الرسالة . انقر ok ، وستحصل على القائمة التالية ، فإنقر على Design view . فينفتح لك النموذج في وضع التصميم . وكما اخبرتك ، فإنه معطوب ولا تستطيع استعماله ، وانما استعمل النوذج الآخر الذي عملت لك. جعفر dd.zip

تفضل Function chk_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 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 Function err_chk_BeforeUpdate: If err.Number = 3021 Then Resume Next Else MsgBox err.Number & vbCrLf & err.Description End If End Function جعفر

الآن جاء دوري في شرح كود الاستاذ شفان Nz([cut];0)) Nz معناه Null to Zero ، اي تحويل قيمة اللاشيء (لاحظ ان ما قلت الفاضي ، لأن الفاضي معناه انه كانت هناك قيمة وتم تفريغها) للحقل cut الى صفر (ويمكنك وضع اي قيمة او حرف بدل الصفر) مختصر كفاية وهاي الشرح المطول: جعفر

السلام عليكم اخوي حمدي انا مسافر ، فما قدرت انظر في المنتدى الا الآن في الواقع انا لم اغير في المعادلة اللي انت كنت عاملها، ولكني عملتها بطريقة اخرى ، وبنفس نتائج معادلتك!! صحيح ما كانت تظهر لك رسالة الخطأ ، ولكن النتيجة هي هي!! انت تقول في الكود: اذا "1/1ب" > 0 (مثلا) وطبعا ما ممكن ان تقارن حقل نصي بهذه الهيئة مع الصفر ، فتظهر لك رسالة الخطأ !! هنا انا طلبت من الكود عدم استخدام هذا السطر ، فجربه: Function chk_BeforeUpdate(Cancel As Integer) 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 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 ctl.Value = "" End If ' End If rst.Close: Set rst = Nothing: dbs.Close End Function جعفر