Foksh

جرب التعديل بعد ازالة اسم الصنف كشرط التوريد.accdb

هذه الجملة تنفي هذه الجملة في طلبك 😂

الأكواد الثلاثة هي استعلامات SQL موجودة باسماء Query1 , Query2 , Query3 .. وضعت الكود في وظيفة مستقلة واستدعيتها في حدث بعد التحديث لمربعات النص الثلاثة في النموذج .

صديقي الدكتور @الحلبي ،، وعليكم السلام ورحمة الله وبركاته ،، مع أني دخلت في دوامة لحتى أفهم المطلوب 😄 ، لكن دعنا بداية نخطو خطوة خطوة .. بدايةً لازم نبدأ باستعلام يسترجع لنا جميع التوريدات الموجودة وبنفس الوقت يحسب عدد التوريدات لكل اسم صنف ونوع توريد في نفس اليوم. ونشوف الاستعلام التالي إن كان فعلاً سيسترجع المطلوب أم لا :- SELECT Main.nume, Main.typtest, Main.bookingdate, Count(*) AS num_of_supplies FROM Main GROUP BY Main.nume, Main.typtest, Main.bookingdate; وبعدين هنحاول نستخدم دالة العد DCount علشان نحسب عدد التوريدات السابقة من نفس النوع والصنف والتاريخ ، وبعدها يتم تعيين الرقم الصحيح للتوريد الحالي بإضافة الرقم 1 للعدد السابق ، ونجرب على الاستعلام التالي :- SELECT a.nume, a.typtest, a.bookingdate, (SELECT COUNT(*) FROM Main AS b WHERE b.nume = a.nume AND b.typtest = a.typtest AND b.bookingdate = a.bookingdate AND b.k < a.k)+1 AS k FROM main AS a; الآن علشان نحدث قيمة الحقل K في الجدول Main بقيمة رقم التوريد الجديدة لكل صنف ونوع وتاريخ ، نستخدم استعلام تحديث البسيط ده . وطبعاً استثنيت القيم الفارغة ، ونجرب :- UPDATE Main SET k = (SELECT COUNT(*) FROM SupplyTable AS b WHERE b.nume = Main.nume AND b.typtest = Main.typtest AND b.bookingdate = Main.bookingdate AND b.k <= SupplyTable.k) WHERE Main.k IS NULL; الآن في النموذج Main اختر اي حدث تريده ونحط الكود التالي لإضافة القيمة في مربع النص K برقم التوريد الجديد بناءً على القيم الموجودة في مربعات النص (nume و typtest و bookingdate) :- Dim newK As Integer newK = DCount("*", "SupplyTable", "nume='" & Me.nume & "' AND typtest='" & Me.typtest & "' AND bookingdate=#" & Me.bookingdate & "#") + 1 Me.k = newK حيث تم حجز متغير رقمي واسميته كمثال newK يقوم بعد القيم لرقم التوريد الجديد . التوريد.accdb

أخي @jo_2010 ، جرب هذا الكود ؟؟ مع العلم أن كود الأستاذ @سامي الحداد يعمل بنجاح بعد تجربتي له ، ولكنني أعتقد أنك تواجه مشكلة في حذف ملفات الـ PDF خصوصاً .. والسبب هو أن برنامج Acrobat Reader يعمل في الخلفية في الويندوز لديك وهو بدوره يقوم بفتح الملف عنط طريقه كوسيط في النموذج لديك ، وبذلك فأنت تحاول حذف ملف محجوز ومفتوح ومشغول من قبل مستخدم آخر . وطبعاً في حال تم اغلاق البرنامج الوسيط فإنه لا يمكنك عرض ملفات الـ PDF في النموذج إلا بعد عمل إعادة تشغيل للويندوز . طبعاً هذا من وجهة نظري ، والله أعلم Private Sub Del_Click() On Error GoTo ErrHandler If IsNull(Me.MyList) Then MsgBox "يجب اختيار الملف أولاً" & vbNewLine & vbNewLine & "اختـار اسـم الملـف من القائمـة", vbCritical + vbMsgBoxRight, "تنبيه" Exit Sub End If Dim sSQL As String Dim FLS_Path As String Dim FDS_path As String Dim MainFolderPath As String Dim fso As Object Dim FileCount As Integer Dim FolderCount As Integer FLS_Path = DLookup("[Attachment_Path]", "[tbl_AttachmentList]", "[Attachment_NO]=[forms]![Attacheds]![MyList]") If FLS_Path = "" Then MsgBox "لم يتم العثور على الملف المحدد", vbCritical + vbMsgBoxRight, "خطأ" Exit Sub End If FDS_path = Left(FLS_Path, InStrRev(FLS_Path, "\") - 1) MainFolderPath = Left(FDS_path, InStrRev(FDS_path, "\") - 1) If MsgBox("هل تريد حذف المرفق؟", vbYesNo + vbMsgBoxRight + vbCritical) = vbYes Then Set fso = CreateObject("Scripting.FileSystemObject") Me.Show_Files.SourceObject = "" If fso.FileExists(FLS_Path) Then fso.DeleteFile FLS_Path, True Else MsgBox "الملف المحدد غير موجود أو قد تم حذفه مسبقاً.", vbExclamation + vbMsgBoxRight, "خطأ" Exit Sub End If Set DB = CurrentDb sSQL = "DELETE FROM tbl_AttachmentList WHERE [Attachment_NO]= " & Me.MyList DB.Execute sSQL FileCount = 0 FolderCount = 0 If fso.FolderExists(FDS_path) Then Dim file As Object Dim subFolder As Object For Each file In fso.GetFolder(FDS_path).Files FileCount = FileCount + 1 Next file For Each subFolder In fso.GetFolder(FDS_path).SubFolders FolderCount = FolderCount + 1 Next subFolder If FileCount = 0 And FolderCount = 0 Then fso.DeleteFolder FDS_path, True End If End If FileCount = 0 FolderCount = 0 If fso.FolderExists(MainFolderPath) Then For Each file In fso.GetFolder(MainFolderPath).Files FileCount = FileCount + 1 Next file For Each subFolder In fso.GetFolder(MainFolderPath).SubFolders FolderCount = FolderCount + 1 Next subFolder If FileCount = 0 And FolderCount = 0 Then fso.DeleteFolder MainFolderPath, True End If End If MsgBox "تم حذف المرفق بنجاح", vbInformation + vbMsgBoxRight, "تأكيد" Me.MyList.Requery End If Exit Sub ErrHandler: MsgBox "حدث خطأ: " & Err.Description, vbCritical, "خطأ" End Sub

جرب فكرتي هذه أخي @ahmed draz ،، 1.zip

أخي الكريم @Mohamed Abo Elala ، الى أن استوعبت الأكواد خرجت بهذه النتيجة ، ولا أعلم إن كانت تخدم فكرتك .. قمت بتعديلات بسيطة على الوظائف التي في المديول الذي يظهر رسائل التنبيه ، واضطررت لإيقافها والإستعاضة عنها بعدد التنبيهات وعرض النتائج في List Box في نموذج الواجهة . ولك حرية التعديل طبعاً ، تفضل . سجل المحضرين.zip

أخي الكريم ،، بالنسبة للعنوان "من التقرير والاستعلام من شريط الادوات " الاستعلام من التقرير يكون حصراً مصدر بيانات لهذا التقرير ,, أما الإستعلام الذي أشرت اليه في الصورة الأولى ، فهو استعلام عام تستطيع استخدامه في نموذج أو تقرير آخر أو أينما تريد اظهار البيانات . هذه وجهة نظري 😊

أخي الكريم أولا أين النموذج frmNavi ؟؟؟ ثانياً ، هلا حددت لنا اين النموذج الذي يحتوي النموذج الفرعي لتنفيذ طلبك ، ولكن اعذرني لحين الوصول الى المنزل لتكون قد أوضحت لنا النموذج الهدف !!!!

أخي الكريم ، تفضل أن كان هذا طلبك .. استخدم الكود التالي في حدث بعد التحديث للكومبوبوكس كما يلي .. Select Case Me.vool.Value Case "كشف حساب" DoCmd.OpenReport "aa1", acViewPreview Case "كشف اجمالي الديون" DoCmd.OpenReport "a2", acViewPreview Case Else MsgBox "يرجى اختيار تقرير لطباعة", vbExclamation End Select طبعاً تستطيع الاضافة والتغيير كما تريد .. Database10.accdb

هل هذا طلبك أخي الكريم ,, ضع الكود في حدث في الحالي للنموذج .. Dim ctl As Control For Each ctl In Me.Controls If ctl.ControlType = acTextBox Then If IsNull(ctl.Value) Or ctl.Value = "" Then ctl.BackColor = vbYellow Else ctl.BackColor = vbWhite End If End If Next ctl تلوين النصوص الفارغة.mdb

أخي الكريم اهلاً وسهلاً بك ,, وعتذر إن لم يحالفني الحظ بالمساعدة .. ارسل مرفقك وأعاننا الله على الإفادة 😊 أو لعدم وجود مرفق ومشاركة مع الأساتذة كفكرة ، هل جربت استخدام الأمر HasData في التقرير ؟ إليك كمثال الكود التالي :- If Me.HasData = False Then Me.Visible = True Else Me.Visible = False End If

وعليكم السلام ورحمة الله وبركاته .. ارسل مرفقك أخي الكريم ,, لمشاركة الأستاذ @kkhalifa1960 في تقديم الحلول

وما الذي يمنع ؟؟ ما هو مصدر بيانات النموذج الرئيسي ، وارفق ملفك للإطلاع عليه.

بحكم اني بعيد عن الكمبيوتر هذه الفترة بسبب العمل ، لكن إن سمحت لي الزروف الليلة بتابع معك .

مشاركة مع الأستاذ @kkhalifa1960 .. راجع هذه المشاركة ، تفيدك بدون أكواد 🤗

من رأيي ( وأنت غير ملزم به ) أن تجعل رقم الطالب هو الحقل المشترك أو المفتاح الأساسي في جميع الجداول التي ذكرتها ، بحيث من خلال رقم الطالب تقدر تعرف معلمه ومواده وفصله وصفه وحتى علاماته وترفيعاته وإسم جارهم كمان 😅

استخدم التعبير Kill ثم المسار أو اسم مربع النص الذي يحتوي على المسار قبل جملة الحذف من الجدول 👍

ما شاء الله ، عمل جميل من الشرح ، بارك الله فيك أخي @jamal2080 🥰

أخي @Abdelaziz Osman ، لا تحتاج كود لهذه الوظيفة فآكسيس يوفرها لك من خلال أن تحدد مربع النص الذي تريده ، ثم من تبويب Format ، انزل لآخر خيار Try.accdb

عليكم السلام ورحمة الله وبركاته أخي @Abdelaziz Osman .. استخدم هذا الكود في حدث قبل التحديث لمربع النص Infoo Private Sub infoo_BeforeUpdate(Cancel As Integer) Dim rs As Recordset Dim lastValue As String Dim newValue As String Set rs = CurrentDb.OpenRecordset("SELECT TOP 1 * FROM Mod ORDER BY [infoo] DESC") If Not rs.EOF Then lastValue = rs("infoo") End If rs.Close newValue = Me.infoo.Value If DateValue(newValue) > DateValue(lastValue) Then MsgBox "íÑÌì ÇáÊÃßÏ ãä ÇáÊÓáÓá!", , "ÊäÈíå" Me.Undo Cancel = True End If End Sub وهذا مثالك ,, عدم تجاوز التسلسل.accdb

تفضل أخي @Luqman Khooshnaw ، تم استخدام التنسيق الشرطي في التقرير كما طلبت لتنفيذ المطلوب Drags.accdb

تفضل أخي @أبو منتظر ، تم إنشاء وظيفةة واحدة في النموذج تقوم بالمهام جميعها ، واستدعائها عند النقر قيم الـ Check Box . Private Sub UpdateNoteD() Dim checkedItems As String Dim firstItemChecked As Boolean firstItemChecked = False If Me.uu = True Then If Not firstItemChecked Then checkedItems = checkedItems & "حضر " & Me.Adress firstItemChecked = True Else checkedItems = checkedItems & "، " & Me.Adress End If End If If Me.VV = True Then If Not firstItemChecked Then checkedItems = checkedItems & "حضر " & Me.Child2 firstItemChecked = True Else checkedItems = checkedItems & "، " & Me.Child2 End If End If If Me.ww = True Then If Not firstItemChecked Then checkedItems = checkedItems & "حضر " & Me.Child3 firstItemChecked = True Else checkedItems = checkedItems & "، " & Me.Child3 End If End If If Me.XX = True Then If Not firstItemChecked Then checkedItems = checkedItems & "حضر " & Me.Child4 firstItemChecked = True Else checkedItems = checkedItems & "، " & Me.Child4 End If End If If Me.yy = True Then If Not firstItemChecked Then checkedItems = checkedItems & "حضر " & Me.Child5 firstItemChecked = True Else checkedItems = checkedItems & "، " & Me.Child5 End If End If Me.NoteD = checkedItems End Sub ويتم استدعائها بالأمر UpdateNoteD Merge Names.mdb

استكمالاً لما سبق في المشروع والإنتهاء منه 👆 :- وقد انتهيت ولله الحمد من برنامج صلوات 2024 Salawat ، مع آخر إضافة وهي إتجاه القبلة . في المرفق تم إضافة ملفي صوت أذان بإمتداد Mp3 ، بصوت الشيخ منصور الزهراني و الشيخ ماجد الهمذاني ؛ وتستطيع التغيير حسب الرغبة .