ابوخليل

انظر المرفق printRprt3.rar

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

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

ابحث هنا عن موضوع قطع الاتصال عن المستخدمين الآخرين موجود هنا تمت مناقشته تحتاج اليه عند حدوث مشكلة او عند التعديل والتطوير

انظر هذا الموضع سوف يفيدك ان شا الله

نعم او هكذا forms!formain!subform!FieldName.Enabled = False

DoCmd.CopyObject , Me.comboform, acForm, "No deletion" حلوة .. سلمت اناملك .. @TQTHAMI ننتظر المزيد

نعم غير المعيار الى [Forms]![كشف حساب]![مبلغ]

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

تفضل بمجرد اختيار المادة يظهر لك عدد الحقول الفارغة Private Sub txt_nshat_AfterUpdate() Dim i, R As Integer Dim rs As Recordset Dim x As String Set rs = Me.RecordsetClone rs.MoveLast rs.MoveFirst x = txt_nshat For i = 1 To rs.RecordCount If Not IsNull(rs.Fields(x)) Then rs.MoveNext Else R = R + 1 rs.MoveNext End If Next Me.fark = R End Sub رصد الانشطة4.rar

ما دامت عناصر وكائنات القاعدة كتبت بحروف انجليزية فليس المشكلة من الاصدار او النسخة العربية المعمول عليها البرنامج الرسالة الظاهرة في الصورة تعني ان المشكلة في القاعدة الخلفية ( قاعدة الجداول ) جرب : اعمل قاعدة بيانات اكسس جديدة ثم استورد الجداول اليها .. بعد ذلك استبعد القديمة وضع الجديدة مكانها ولا تنسى تسميتها بنفس الاسم القديم من اجل لا تحتاج لاعادة ربط الجداول بالواجهات ايضا تأكد من المسار .. في بعض الاوقات يكون الخلل في اسم المسار

او من خلال النموذج جعل خانة الخيار ( نعم/ لا ) شرط في اظهار او اخفاء زر الطباعة ، او اظهار مربع نص بلون احمر يفيد بوضعه

تفضل استبدل كامل الكود الموجود في الحدث بهذا If Me.txt_nshat = "" Or IsNull(Me.txt_nshat) Then MsgBox "رجاء اختر النشاط", vbCritical Exit Sub End If Me.txt_drga2 = Me.drga2 If Me.drga2 = "" Or IsNull(Me.drga2) Then MsgBox "رجاء ضع الدرجة المطلوبة", vbCritical Exit Sub End If Dim i As Integer, R As Integer, k As Integer Dim rs As Recordset Dim x As String Set rs = Me.RecordsetClone rs.MoveLast R = rs.RecordCount rs.MoveFirst x = txt_nshat k = DCount(x, "tb_trm1", x > "0") If k > 0 Then MsgBox "سبق رصد الدرجة ! لا يمكنك تسجيل هذه المادة" Else rs.MoveFirst Do While Not rs.EOF rs.Edit rs.Fields(x) = drga2 rs.Update rs.MoveNext Loop MsgBox "تم رصد نشاط" & " " & Me.txt_nshat.Column(1) End If Me.Refresh

شكرا لثنائك مهندس قاسم .. بارك الله فيك وكتب اجرك مثلك تماما في البداية جاء على بالي الجدول ولكني نظرت فإذا القيم ثابتة لا يمكن ان تتبدل . لذا افضل مكان لها هو الكود الاعمال التي يحتمل ان يجري عليها التعديل مثل .. جداول الحصص المدرسية او سلم الرواتب والمكافآت ... وامثالها .. فهذه يجب ن يكون مكانها الجدول

تفضل تم تعديل المثال باضافة الجنس الى الجدول ، والتعديل في الاستعلام على اساس هذا التعديل ، وتهيئة الوحدة النمطية لوضع اوزان الإناث .. لاني نسخت طبق الاصل من الذكور .. كل ما عليك عمله هو تغيير الاوزان الى ما يناسب النساء الوزن المثالي3.rar

تفضل هذه الوحدة النمطية الخاصة كما في الصورة اعلاه افتح الاستعلام وانظر النتيجة : الرقم الموجب زيادة والرقم السالب نقص والصفر هو الوزن المثالي يمكنك بناء نموذجك على الاستعلام ولا حظ ان اي تغيير على الارقام سيتغير التقييم آليا يمكن ايضا ادخال الجنس ذكر / انثى ضمن الوحدة النمطية ان رغبت في ذلك سوف اضع لك الاساس وانت تدخل الاوزان Public Function GetPerfectWeight(xheight As Integer, xold As Integer) As Double If xheight = 150 Then If xold <= 24 Then GetPerfectWeight = 57 If xold >= 25 And xold <= 29 Then GetPerfectWeight = 60 If xold >= 30 And xold <= 39 Then GetPerfectWeight = 61 If xold >= 40 And xold <= 49 Then GetPerfectWeight = 64 If xold >= 50 Then GetPerfectWeight = 67 End If If xheight = 152 Then If xold <= 24 Then GetPerfectWeight = 59 If xold >= 25 And xold <= 29 Then GetPerfectWeight = 62 If xold >= 30 And xold <= 39 Then GetPerfectWeight = 63 If xold >= 40 And xold <= 49 Then GetPerfectWeight = 65 If xold >= 50 Then GetPerfectWeight = 68 End If If xheight = 154 Then If xold <= 24 Then GetPerfectWeight = 60 If xold >= 25 And xold <= 29 Then GetPerfectWeight = 63 If xold >= 30 And xold <= 39 Then GetPerfectWeight = 64 If xold >= 40 And xold <= 49 Then GetPerfectWeight = 67 If xold >= 50 Then GetPerfectWeight = 70 End If If xheight = 156 Then If xold <= 24 Then GetPerfectWeight = 63 If xold >= 25 And xold <= 29 Then GetPerfectWeight = 64 If xold >= 30 And xold <= 39 Then GetPerfectWeight = 66 If xold >= 40 And xold <= 49 Then GetPerfectWeight = 68 If xold >= 50 Then GetPerfectWeight = 72 End If If xheight = 158 Then If xold <= 24 Then GetPerfectWeight = 63 If xold >= 25 And xold <= 29 Then GetPerfectWeight = 66 If xold >= 30 And xold <= 39 Then GetPerfectWeight = 67 If xold >= 40 And xold <= 49 Then GetPerfectWeight = 71 If xold >= 50 Then GetPerfectWeight = 73 End If If xheight = 160 Then If xold <= 24 Then GetPerfectWeight = 65 If xold >= 25 And xold <= 29 Then GetPerfectWeight = 67 If xold >= 30 And xold <= 39 Then GetPerfectWeight = 69 If xold >= 40 And xold <= 49 Then GetPerfectWeight = 72 If xold >= 50 Then GetPerfectWeight = 75 End If If xheight = 162 Then If xold <= 24 Then GetPerfectWeight = 66 If xold >= 25 And xold <= 29 Then GetPerfectWeight = 68 If xold >= 30 And xold <= 39 Then GetPerfectWeight = 70 If xold >= 40 And xold <= 49 Then GetPerfectWeight = 74 If xold >= 50 Then GetPerfectWeight = 76 End If If xheight = 164 Then If xold <= 24 Then GetPerfectWeight = 67 If xold >= 25 And xold <= 29 Then GetPerfectWeight = 69 If xold >= 30 And xold <= 39 Then GetPerfectWeight = 72 If xold >= 40 And xold <= 49 Then GetPerfectWeight = 75 If xold >= 50 Then GetPerfectWeight = 77 End If If xheight = 166 Then If xold <= 24 Then GetPerfectWeight = 68 If xold >= 25 And xold <= 29 Then GetPerfectWeight = 71 If xold >= 30 And xold <= 39 Then GetPerfectWeight = 74 If xold >= 40 And xold <= 49 Then GetPerfectWeight = 76 If xold >= 50 Then GetPerfectWeight = 79 End If If xheight = 168 Then If xold <= 24 Then GetPerfectWeight = 69 If xold >= 25 And xold <= 29 Then GetPerfectWeight = 73 If xold >= 30 And xold <= 39 Then GetPerfectWeight = 75 If xold >= 40 And xold <= 49 Then GetPerfectWeight = 78 If xold >= 50 Then GetPerfectWeight = 80 End If If xheight = 170 Then If xold <= 24 Then GetPerfectWeight = 70 If xold >= 25 And xold <= 29 Then GetPerfectWeight = 74 If xold >= 30 And xold <= 39 Then GetPerfectWeight = 77 If xold >= 40 And xold <= 49 Then GetPerfectWeight = 80 If xold >= 50 Then GetPerfectWeight = 83 End If If xheight = 172 Then If xold <= 24 Then GetPerfectWeight = 72 If xold >= 25 And xold <= 29 Then GetPerfectWeight = 76 If xold >= 30 And xold <= 39 Then GetPerfectWeight = 78 If xold >= 40 And xold <= 49 Then GetPerfectWeight = 81 If xold >= 50 Then GetPerfectWeight = 85 End If If xheight = 174 Then If xold <= 24 Then GetPerfectWeight = 74 If xold >= 25 And xold <= 29 Then GetPerfectWeight = 77 If xold >= 30 And xold <= 39 Then GetPerfectWeight = 80 If xold >= 40 And xold <= 49 Then GetPerfectWeight = 83 If xold >= 50 Then GetPerfectWeight = 86 End If If xheight = 176 Then If xold <= 24 Then GetPerfectWeight = 76 If xold >= 25 And xold <= 29 Then GetPerfectWeight = 78 If xold >= 30 And xold <= 39 Then GetPerfectWeight = 82 If xold >= 40 And xold <= 49 Then GetPerfectWeight = 85 If xold >= 50 Then GetPerfectWeight = 88 End If If xheight = 178 Then If xold <= 24 Then GetPerfectWeight = 77 If xold >= 25 And xold <= 29 Then GetPerfectWeight = 80 If xold >= 30 And xold <= 39 Then GetPerfectWeight = 83 If xold >= 40 And xold <= 49 Then GetPerfectWeight = 87 If xold >= 50 Then GetPerfectWeight = 90 End If If xheight = 180 Then If xold <= 24 Then GetPerfectWeight = 79 If xold >= 25 And xold <= 29 Then GetPerfectWeight = 82 If xold >= 30 And xold <= 39 Then GetPerfectWeight = 85 If xold >= 40 And xold <= 49 Then GetPerfectWeight = 89 If xold >= 50 Then GetPerfectWeight = 92 End If If xheight = 182 Then If xold <= 24 Then GetPerfectWeight = 81 If xold >= 25 And xold <= 29 Then GetPerfectWeight = 84 If xold >= 30 And xold <= 39 Then GetPerfectWeight = 87 If xold >= 40 And xold <= 49 Then GetPerfectWeight = 90 If xold >= 50 Then GetPerfectWeight = 94 End If If xheight = 184 Then If xold <= 24 Then GetPerfectWeight = 82 If xold >= 25 And xold <= 29 Then GetPerfectWeight = 86 If xold >= 30 And xold <= 39 Then GetPerfectWeight = 89 If xold >= 40 And xold <= 49 Then GetPerfectWeight = 92 If xold >= 50 Then GetPerfectWeight = 96 End If If xheight = 186 Then If xold <= 24 Then GetPerfectWeight = 84 If xold >= 25 And xold <= 29 Then GetPerfectWeight = 87 If xold >= 30 And xold <= 39 Then GetPerfectWeight = 90 If xold >= 40 And xold <= 49 Then GetPerfectWeight = 94 If xold >= 50 Then GetPerfectWeight = 98 End If If xheight = 188 Then If xold <= 24 Then GetPerfectWeight = 85 If xold >= 25 And xold <= 29 Then GetPerfectWeight = 89 If xold >= 30 And xold <= 39 Then GetPerfectWeight = 92 If xold >= 40 And xold <= 49 Then GetPerfectWeight = 96 If xold >= 50 Then GetPerfectWeight = 100 End If If xheight = 190 Then If xold <= 24 Then GetPerfectWeight = 86 If xold >= 25 And xold <= 29 Then GetPerfectWeight = 90 If xold >= 30 And xold <= 39 Then GetPerfectWeight = 95 If xold >= 40 And xold <= 49 Then GetPerfectWeight = 98 If xold >= 50 Then GetPerfectWeight = 102 End If If xheight = 192 Then If xold <= 24 Then GetPerfectWeight = 87 If xold >= 25 And xold <= 29 Then GetPerfectWeight = 91 If xold >= 30 And xold <= 39 Then GetPerfectWeight = 96 If xold >= 40 And xold <= 49 Then GetPerfectWeight = 100 If xold >= 50 Then GetPerfectWeight = 104 End If If xheight = 194 Then If xold <= 24 Then GetPerfectWeight = 88 If xold >= 25 And xold <= 29 Then GetPerfectWeight = 92 If xold >= 30 And xold <= 39 Then GetPerfectWeight = 98 If xold >= 40 And xold <= 49 Then GetPerfectWeight = 102 If xold >= 50 Then GetPerfectWeight = 106 End If If xheight = 196 Then If xold <= 24 Then GetPerfectWeight = 89 If xold >= 25 And xold <= 29 Then GetPerfectWeight = 93 If xold >= 30 And xold <= 39 Then GetPerfectWeight = 100 If xold >= 40 And xold <= 49 Then GetPerfectWeight = 104 If xold >= 50 Then GetPerfectWeight = 108 End If If xheight = 198 Then If xold <= 24 Then GetPerfectWeight = 90 If xold >= 25 And xold <= 29 Then GetPerfectWeight = 94 If xold >= 30 And xold <= 39 Then GetPerfectWeight = 101 If xold >= 40 And xold <= 49 Then GetPerfectWeight = 106 If xold >= 50 Then GetPerfectWeight = 110 End If If xheight = 200 Then If xold <= 24 Then GetPerfectWeight = 91 If xold >= 25 And xold <= 29 Then GetPerfectWeight = 95 If xold >= 30 And xold <= 39 Then GetPerfectWeight = 103 If xold >= 40 And xold <= 49 Then GetPerfectWeight = 108 If xold >= 50 Then GetPerfectWeight = 112 End If End Function الوزن المثالي2.rar

بعد التجربة رأيت من الافضل تحديد المواد المعتمدة بالادراج الجماعي ،، بدلا من وضع الشروط عملت لك نموذج لجدول النشاط من خلاله يمكنك التحكم باظهار المواد في مربع التحرير التي ينطبق عليها التعميم رصد الانشطة3.rar

خير ان شاء الله سوف اجعل البرنامج يرصد الدرجة اذا كان الحقل خاليا فقط .. بدون رسائل غدا ان شاء .. حان وقت النوم

السلام عليكم الصورة غير واضحة ، الجزء السفلي الايسر من الصورة مظلل بالسواد والاسطر السفلية لا تظهر حاول ترفق صورة اكثر جودة

هل يحدث ان يكون البعض رصد لهم المادة وبعضهم لم يرصد اقصد لو كان العمود يحتوي على بعض الدرجات لبعض الطلاب ...... هل هذا وارد ؟ ثانيا : عندما عدلت على المثال لم يعجبني طريقة كتابة المواد فقد تحتاج الى مواد اخرى ، فارى انك تكمل بيانات الجدول وتضع فيه جميع المواد على الصيغة التي انا عملتها وسوف اعمل لك تحكم في اظهار المواد المختارة في مربع التحرير .. اظهار/ اخفاء

تم تعديل الكود ليأخذ سطرا واحدا Private Sub Command138_Click() Dim i As Object, Msg$, T#, F#, U# For Each i In CreateObject("Scripting.FileSystemObject").Drives With i If .IsReady And .DriveType = 1 Then T = .TotalSize: F = .FreeSpace: U = T - F If Len(Msg) Then Msg = Msg & vbLf & vbLf Msg = .DriveLetter & ":" & " " & .VolumeName & " " Msg = Msg & "(" & .FileSystem & ")" & " " Msg = Msg & "(" & FormatSize(T) & "Tot" & ")" & " " Msg = Msg & "(" & FormatSize(F) & "free" & ")" & " " Msg = Msg & "(" & FormatSize(U) & "used" & ")" End If End With Next If Len(Msg) Then coDesks.AddItem Msg End Sub وهذه وحدة نمطية لارجاع حجم الرقم او ما يسمى السعة Public Function FormatSize(ByVal Size As Currency) As String Const Kilobyte As Currency = 1024@ Const TenK As Currency = 10240@ Const HundredK As Currency = 102400@ Const ThousandK As Currency = 1024000@ Const Megabyte As Currency = 1048576@ Const TenMeg As Currency = 10485760@ Const HundredMeg As Currency = 104857600@ Const ThousandMeg As Currency = 1048576000@ Const Gigabyte As Currency = 1073741824@ Const TenGig As Currency = 10737418240@ Const HundredGig As Currency = 107374182400@ Const ThousandGig As Currency = 1073741824000@ Const Terabyte As Currency = 1099511627776@ Select Case Size Case Is < Kilobyte: FormatSize = Int(Size) & " bytes" Case Is < TenK: FormatSize = Format(Size / Kilobyte, "0.00") & " KB" Case Is < HundredK: FormatSize = Format(Size / Kilobyte, "0.0") & " KB" Case Is < ThousandK: FormatSize = Int(Size / Kilobyte) & " KB" Case Is < TenMeg: FormatSize = Format(Size / Megabyte, "0.00") & " MB" Case Is < HundredMeg: FormatSize = Format(Size / Megabyte, "0.0") & " MB" Case Is < ThousandMeg: FormatSize = Int(Size / Megabyte) & " MB" Case Is < TenGig: FormatSize = Format(Size / Gigabyte, "0.00") & " GB" Case Is < HundredGig: FormatSize = Format(Size / Gigabyte, "0.0") & " GB" Case Is < ThousandGig: FormatSize = Int(Size / Gigabyte) & " GB" Case Else: FormatSize = Format(Size / Terabyte, "0.00") & " TB" End Select End Function Database4.rar

تفضل .. منقول ... Const MB& = 1048576 Dim i As Object, Msg$, T#, F#, U# For Each i In CreateObject("Scripting.FileSystemObject").drives With i If .IsReady And .DriveType = 1 Then T = .TotalSize / MB: F = .FreeSpace / MB: U = T - F If Len(Msg) Then Msg = Msg & vbLf & vbLf Msg = "Drive " & .DriveLetter & ":" & vbTab Msg = Msg & .VolumeName & " (" & .FileSystem & ")" Msg = Msg & vbLf & "Total size:" & vbTab Msg = Msg & Format(T, "#,##0 MB") & vbLf Msg = Msg & "Free space:" & vbTab Msg = Msg & Format(F, "#,##0 MB") & vbLf Msg = Msg & "Used space:" & vbTab Msg = Msg & Format(U, "#,##0 MB") End If End With Next If Len(Msg) Then MsgBox Msg

Dim i As Integer, R As Integer Dim rs As Recordset Dim x As String Set rs = Me.RecordsetClone rs.MoveLast R = rs.RecordCount rs.MoveFirst x = txt_nshat For i = 1 To R rs.Edit rs.Fields(x) = drga2 rs.Update rs.MoveNext Next غفلت عن تعديل آخر سطر MsgBox ("تم رصد نشاط") & " ( " & Me.txt_nshat & " ) " بدله بهذا MsgBox ("تم رصد نشاط") & " ( " & Me.txt_nshat.Column(1) & " ) " التعديل الذي تم انظر في جدول tb_nshat وانظر في مصدر بيانات مربع التحرير رصد الانشطة2.rar

عليكم السلام وجدت هذا الكود وقمت بالتعديل عليه بحيث يظهر الاقراص الخارجية في قائمة وفي القائمة الاخرى يظهر جميع الأقراص وتم تطبيقه على المرفق ادناه Dim vl As Scripting.FileSystemObject Dim Drv As Scripting.Drive Set vl = New Scripting.FileSystemObject For Each Drv In vl.Drives coDesks.AddItem Drv.DriveLetter If Drv.DriveType = Removable Then coDesks2.AddItem Drv.DriveLetter End If Next Drv عند نقلك الكود الى برنامجك لا تنسى اضافة المكتبة الخاصة ... اطلع عليها في المثال deskDb.rar

وجدت لك هذا المرفق يشتمل على بعض الجداول الاساسية ، اعجبني التصميم لعلك تستفيد منه account.mdb