jjafferr

وعليكم السلام لا تضيف حقل/حقول ، وانما اخفي الحقل/الحقول الاضافية و اجعل العرض = 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 جعفر

تفضل جرب هاي المرفق 942.جدول الحصص.accdb.zip

وعليكم السلام شوف هذا الرابط وبالذات هذه الفقرة

وعليكم السلام واهلا وسهلا بك في المنتدى جرب هذا الرابط: جعفر

قواعد المشاركة فى الموقع اضغط هنـــــــــامن فضلك لقراءة القواعد كاملة و بصفة خاصة نؤكدعلى ما يلي 1- يمنع منعا باتا نشر أية مواد تخالف حقوق الملكية الفكرية و يرجى الابلاغ عن المشاركات المخالفة من خلال زر تقرير اسفل المشاركة 2-يجب استخدام خاصيةالبحث قبل طرح السؤال توفيرا للوقت و الجهد. 3-ضرورة كتابة عنوان واضح للموضوع يدل على محتواه ويعطي وصفاً مختصرا للسؤال. 4-ممنوع منعا باتاً كتابة عناوين سينمائية مثل عاجل ، نداء الي فلان ، الي الخبراء ، طلب مساعدة ، أريد حلا..... 5-يمكن استعجال الرد باستخدام تعبير -للرفع- و غير مسموح بالالحاح او اللوم فجميع الاعضاء يشاركون تطوعا طبقا لسعة وقتهم. ومخالفة ذلك تعرض الموضوع للحذف

بدل استخدام الصورة مباشرة ، استخدم زر وعليه صورة: . او تقدر تستخدم زر فوق الصورة ، وتخليه شفاف جعفر

انا لم استعمل الكود سابقا ، ولكني اعرف ان الكود سيقوم بعمل "العمل اليدوي" ، وبالتالي نصل الى نفس النقطة!! جعفر

الطريقة الاولى ، وهي المعتادة: اجعل (Tab index) الحقل الاول = 0 اجعل (Tab index) الحقل الثاني = 1 اجعل (Tab index) الايقونه = 2 بينما طريقة اخي كاسر هي: اجعل (Tab index) الحقل الاول = 0 اجعل (Tab index) الحقل الثاني = 1 وفي حدث "بعد التحديث" للحقل رقم 2 ، اكتب (على اساس اسم الايقونه A ) : me.A.SetFocus جعفر

وعليكم السلام بما اني لم اجرب هذا الشيء ، فاضطررت ان ابحث عنه ، ولقيت هذين الحلين من هنا: https://answers.microsoft.com/en-us/office/forum/office_2010-access/open-accdr-file-protected-with-database-password/0c363087-577e-4888-a970-d2a67276bae5?page=3 الاول يتطلب ادخال الباسورد Dim strPath As String strPath = "YourPath\To\OtherDatabase.accdr" Application.FollowHyperlink strPath والاخر Sub StartPasswordedDatabaseRuntime( _ strPathToDatabase As String, _ Optional strPassword As String, _ Optional strPathToRuntime As String, _ Optional blnQuit As Boolean) ' Start a runtime database that has a database password. Dim appRT As Access.Application Dim strPathToDummy As String Dim blnStillOpen As Boolean Const Q As String = """" If Len(strPassword) = 0 Then strPassword = InputBox("Please enter password:") End If If Len(strPathToRuntime) = 0 Then strPathToRuntime = SysCmd(acSysCmdAccessDir) & "msaccess.exe" End If strPathToDummy = CurrentProject.path & "\Dummy.accdb" If Len(Dir(strPathToDummy)) = 0 Then Application.DBEngine.CreateDatabase strPathToDummy, dbLangGeneral, dbVersion120 End If Shell _ Q & strPathToRuntime & Q & " " & Q & strPathToDummy & Q & " /runtime", _ vbNormalFocus Set appRT = GetObject(strPathToDummy) With appRT .CloseCurrentDatabase .OpenCurrentDatabase strPathToDatabase, , strPassword End With On Error Resume Next blnStillOpen = True Do While blnStillOpen DoEvents Err.Clear If appRT Is Nothing Then blnStillOpen = False ElseIf Len(appRT.CurrentProject.path) = 0 Then blnStillOpen = False End If If Err.Number <> 0 Then blnStillOpen = False End If Loop If blnQuit Then Application.Quit ' if we're done here. End If End Sub جعفر

السلام عليكم اخوي ابو زاهر اذا كان النموذج مستمر: فأي تنسيق/تغيير تعمله على حقل ، فجميع الحقول تأخذ هذا التنسيق/التغيير ، فالطريقة الوحيدة لعمل تنسيق/تغيير على حقل معين ، هو عن طريق التنسيق الشرطي (سواء يدويا في النموذج مباشرة ، او عن طريق الكود). جعفر

بالعكس ، اكثر من مشاركة تعتبر اثراء للموضوع واذا لاحظت ، فانا لم اشير الى SetFocus في مشاركتي جعفر

وعليكم السلام 1. للتنقل بين كائنات النموذج ، انظر هنا وللعلم ، الايقونه (الصورة) تعتبر كائن في الاكسس ، 2. مادام نموذج الاكسس مصدر بياناته مرتبط بجدول/استعلام ، فهو يحفظ البيانات تلقائيا ، بزر او بدون زر ، فاذا اردت ان تحفظ البيانات بزر ، فيجب ان التعامل لحفظ البيانات بالكود. جعفر

وعليكم السلام نعم ، تظهر هذه الرسالة مرة واحدة فقط عند التشفير ، فما هي المشكلة؟ جعفر

If txtc > 0 Then Beep If MsgBox("...هذا الفصل " & الاحد1 & "..لديه مادة.." & vbCrLf & _ " باسم : " & txtc2 & vbCrLf & _ " للمدرس : " & txtc3, _ vbYesNo + vbCritical + vbMsgBoxRight, "تنبيه") = vbNo Then Cancel = True End If End If

اليك رابطين و و http://www.databasedev.co.uk/report_printing.html جعفر