كل الانشطه

مشاركةً مع الزملاء الافاضل تفضل اسناذ @dd13901390 المطلوب حسب ما فهمت بالشرح والمرفق التالي . ووافني بالرد . dd13901390.rar

جزاكم الله خير ممكن تطبيقها على الامثال

عاشت ايدك

مشاركةً مع أخي الأستاذ @kanory ، تعديل بسيط Private Sub Form_Load() Dim obj As AccessObject, f As String, r As String For Each obj In CurrentProject.AllForms If LCase(obj.Name) <> "main" Then r = r & "نموذج:" & obj.Name & ";" Next f = Dir(CurrentProject.Path & "\*.xls*") Do While f <> "": r = r & "ملف:" & f & ";": f = Dir(): Loop Me.مربع_تحرير_وسرد1.RowSourceType = "Value List" Me.مربع_تحرير_وسرد1.RowSource = Left(r, Len(r) - 1) End Sub Private Sub مربع_تحرير_وسرد1_AfterUpdate() On Error GoTo ErrorHandler If Left(Me.مربع_تحرير_وسرد1, 6) = "نموذج:" Then DoCmd.OpenForm Mid(Me.مربع_تحرير_وسرد1, 7) Else With CreateObject("Excel.Application") .Visible = True .Workbooks.Open CurrentProject.Path & "\" & Mid(Me.مربع_تحرير_وسرد1, 5) End With End If Exit Sub ErrorHandler: MsgBox "حدث خطأ: " & Err.Description, vbExclamation End Sub

حبيبي يا بشار ، الله يسعد قلبك ويهنيك ..

@Foksh يسلم ايدك ✋ ماشالله عليك,, شغل فاخر عالاخر فوووكش ,, ربي يزيدك علم ويبارك في رزقك ويكفيك شر الناس ,كل الشكر والتقدير لك

صديقي @Bshar ، جرب هذا التعديل عندك .. Private Sub e2_Click() Dim ctl As Form Set ctl = Me.dff.Form Dim foundValid As Boolean foundValid = False With ctl.RecordsetClone .MoveFirst Do While Not .EOF If ctl.Controls("hgf").Value = True Then foundValid = True Exit Do End If .MoveNext Loop End With If Not foundValid Then MsgBox "لم يتم إدخال أدوية - سيتم الخروج الآن", vbExclamation, "إدارية" DoCmd.Close Exit Sub End If Dim strSQL As String strSQL = "UPDATE [" & ctl.RecordSource & "] " & _ "SET [qunt_x] = Nz([qunt_a], 0) - Nz([qunt_out], 0) " & _ "WHERE [efkt_b] = True" DoCmd.SetWarnings False DoCmd.RunSQL strSQL DoCmd.OpenQuery "efkt_aa", acViewNormal DoCmd.OpenQuery "del_efktc", acViewNormal DoCmd.OpenQuery "ry", acViewNormal DoCmd.SetWarnings True Me.dff.Requery Me.Requery Me.Refresh MsgBox "تم بنجاح", vbInformation, "إدارية" DoCmd.Close DoCmd.OpenForm "efkt" End Sub

@Foksh قليل اشتغل ع اكسس عحسب وقت الفراغ ,, المهم فوووكش ,, اشتغل التعديل 100% ,, بس اذا في طريقه او حل غير لانه وقت ضفت 150 سجل صار مشكله انه عللق الاكسس وهوه يمر عالسجلات ,, شاكر الك مساعدتي بالمقدمه دائما

حبيبي يا بشار ، الله يسعدك ، الحمد لله بخير .. انت اللي مختفي يا زلمة .. جرب هذا التعديل بحيث انه يمر على كل السجلات ، طبعاً لم يتم تعديل اي فكرة من الاستعلامات الـ 3 اللي انت عاملها .. Private Sub e2_Click() Dim i As Integer Dim ctl As Form Set ctl = Me.dff.Form Dim foundValid As Boolean foundValid = False For i = 0 To ctl.Recordset.RecordCount - 1 ctl.Recordset.AbsolutePosition = i If ctl.Controls("hgf").Value = True Then foundValid = True ctl.Controls("c4").Value = Nz(ctl.Controls("c1").Value, 0) - Nz(ctl.Controls("c3").Value, 0) End If Next i If Not foundValid Then MsgBox "لم يتم إدخال أدوية - سيتم الخروج الآن", vbExclamation, "إدارية" DoCmd.Close Exit Sub End If Me.dff.Requery DoCmd.SetWarnings False DoCmd.OpenQuery "efkt_aa", acViewNormal DoCmd.OpenQuery "del_efktc", acViewNormal DoCmd.OpenQuery "ry", acViewNormal DoCmd.SetWarnings True Me.Requery Me.Refresh Me.e2.Enabled = False MsgBox "تم بنجاح", vbInformation, "إدارية" DoCmd.Close DoCmd.OpenForm "efkt" End Sub

شكرا جزيلا أخي الفاضل هجرب وأوافيك بالنتيجة

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

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

بعد إذن معلمي الفاضل @ابوخليل ، قمت بدمج الإستعلامين كما فعلت في السابق ، مع إضافة شرطين ( الفصل والصف ) . أخي @2saad انشئ استعلام جديد وألصق الكود التالي :- PARAMETERS [Forms]![frm_Reports]![ComboSaf] Short, [Forms]![frm_Reports]![termNum] Short; TRANSFORM IIf([Forms]![frm_Reports]![termNum]=1,First(qry_master.mgmo1),First(qry_master.mgmo2)) AS FirstOfmgmo SELECT qry_master.alsaf_Id, qry_master.draseDate, qry_master.Stucard, qry_master.Studentname, qry_master.fsl_id, qry_master.Stugalos, qry_master.StuSery, qry_master.gender, qry_Temp.vHodor, qry_Temp.alnesbah, qry_Temp.tgyeem1, qry_Temp.hala FROM qry_master LEFT JOIN qry_Temp ON qry_master.Stucard = qry_Temp.Stucard WHERE (((qry_master.alsaf_Id)=[Forms]![frm_Reports]![ComboSaf])) GROUP BY qry_master.alsaf_Id, qry_master.draseDate, qry_master.Stucard, qry_master.Studentname, qry_master.fsl_id, qry_master.Stugalos, qry_master.StuSery, qry_master.gender, qry_Temp.vHodor, qry_Temp.alnesbah, qry_Temp.tgyeem1, qry_Temp.hala PIVOT qry_master.madaNum In (1,2,3,4,5,6,7,8,9,10,11,12,13,14); واجعله مصدر سجلات التقرير السابق نفسه ، وجرب النتيجة .

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

طلبك غريب شوي ,,,,,, لكن استخدم هذه الاكواد ............................... Private Sub Form_Load() Dim db As DAO.Database Dim obj As AccessObject Dim strPath As String Dim strFile As String Dim RowSource As String ' إضافة النماذج الموجودة (مع استثناء نموذج "main") Set db = CurrentDb For Each obj In CurrentProject.AllForms If LCase(obj.Name) <> "main" Then RowSource = RowSource & "نموذج:" & obj.Name & ";" End If Next obj ' البحث عن ملفات إكسل في نفس مسار قاعدة البيانات strPath = CurrentProject.Path & "\" strFile = Dir(strPath & "*.xlsx*") ' يشمل xls و xlsx Do While strFile <> "" RowSource = RowSource & "ملف:" & strFile & ";" strFile = Dir Loop ' تحديث مصدر الصفوف لمربع التحرير والسرد If Right(RowSource, 1) = ";" Then RowSource = Left(RowSource, Len(RowSource) - 1) End If Me.مربع_تحرير_وسرد1.RowSourceType = "Value List" Me.مربع_تحرير_وسرد1.RowSource = RowSource End Sub Private Sub مربع_تحرير_وسرد1_AfterUpdate() Dim selectedItem As String selectedItem = Me.مربع_تحرير_وسرد1.Value If Left(selectedItem, 6) = "نموذج:" Then DoCmd.OpenForm Mid(selectedItem, 7) ElseIf Left(selectedItem, 4) = "ملف:" Then Dim filePath As String filePath = CurrentProject.Path & "\" & Mid(selectedItem, 5) Dim xlApp As Object On Error Resume Next Set xlApp = CreateObject("Excel.Application") On Error GoTo 0 If Not xlApp Is Nothing Then xlApp.Visible = True xlApp.Workbooks.Open filePath Else MsgBox "تعذر تشغيل Microsoft Excel.", vbExclamation End If End If End Sub

طلبك موجود في الاستعلامين qry_term11 و qry_term22 Data19.rar

السلام عليكم ورحمة الله , الرجاء المساعده في نموذج efkt عند الضغط على زر ادخال يعمل على تحديث السجل الاول فقط با انقاص الرصيد وباقي السجلات المشار عليها true يبقى الرصيد كما هوه . . شاكرا لكم خدمتكم مرفق stor.accdb

شكرا جزيلا لكما وبارك فيكما وزادكما الله من علمه أخي الفاضل أنا طبقت مثلما قال أخي الكريم ( ابو خليل ) أدام الله عليه الصحة والعافية ولكن لم يفلح معي وأصلا الاستعلام الأول موجود فيه mgmo1 والاستعلام الثاني موجود فيه total

جزاك الله خيرا وجعل علمك فى ميزان حسناتك استاذى الكريم

الله يعافيك أستاذ : hegazee شكرا لكم وبارك الله فيكم

وعليه ، "قضي الأمر الذي فيه تستفتيان" وعليه تم الحل بالتعديل الذي أشار إليه أستاذي الفاضل ( أساس الموضوع ) 😇 .

شكرا استاذنا الفاضل .. والحل او طلب الأخ سعد موجود فعلا .. ويحتاج الى تعديل طفيف ............... 1- الاستعلامان qry_term1 و qry_term2 هما المسؤلان عن عرض الألوان 2- نأخذ من كل واحد نسخة طبق الأصل ثم نعدل على التسمية مثلا qry_term11 و qry_term22 3- نستبدل القيمة color1 الموجودة في الاستعلام الاول بـــــ القيمة mgmo1 4- نستبدل القيمة color2 الموجودة في الاستعلام الثاني بـــــ القيمة total نجعل هذين الاستعلامين مصدر بيانات التقرير هذا كل شيء

السلام عليكم ورحمة الله وبركاتة اخواني الاعزاء الرجاء منكم المساعدة في حل هذا البرنامج وهو عبارة عن فتح النماذج عن طريق القائمة المنسدلة واريد كذلك فتح الملف المرفق بالاكسل يكون من ضمن القائمة باسم (a1 ) طبعا كلهم في الاكسس والمطلوب موجود في البرنامج جزاكم الله خير الجزاء test.accdb a1.xlsx

شكرا جزيلا أخي الفاضل علي تعبك معانا وربنا يجعله في ميزان حسناتك بعد التجربة النتيجة بتحتوي علي درجة التحريري اللي بنسميها في جدول الدرجات Tbl_degree_Detail ( درجة 1) عند اختيار الفصل الدراسي الأول وعند اختيار الفصل الدراسي الثاني تظهر النتيجة مسجل بها درجة التحريري اللي بنسميها ( درجة 2 ) ولكن المفروض في نتيجة الصفوف في الفصل الدراسي الأول ( درجة1 + درجة أعمال1 ) وفي الفصل الدراسي الثاني ( درجة1 + درجة أعمال1 ) + ( درجة2 + درجة أعمال2 ) مقسوم علي 2 انظر جدول الدرجات Tbl_degree_Detail او استعلام qry_master مرفق لكم الملف بعد وضع درجات للصف الثالث للتجربة Data19_4.rar

وعليكم السلام ورحمة الله وبركاته "جزاك الله خيرًا على دعائك الطيب، أسأل الله أن يرزقك أضعاف ما دعوت لي، وأن يبارك لك في عمرك وعملك." هذا الكود يعمل في شيت معاشات لو ربطته بزر لوحده ولكن دمجه مع كود الترحيل يحناج الى وضعه في المكان المناسب وبطريقة مناسبة بحيت يصبح الكود بهذا الشكل With wsTarget.Range("B5:B10000") .HorizontalAlignment = xlRight .VerticalAlignment = xlCenter End With حيث wsTarget تعنى شيت معاشات حيث قمنا بتعريفها في بداية الكود بدلا من اعادة كتابة اسم الشيت كل مرة Set wsTarget = ThisWorkbook.Sheets("معاشات") اليك الملف بعد اظافة محاداة الاسماء لليمين اتمنى انى قدمت لك ما بفيد ترحيل بيانات الموظف المحال للمعاش إلى شيت آخر وحذفه من قاعدة البيانات 7.xlsb