Foksh

يا صديقي ، الحلول البسيطة والمفهومة تأتيك وحدها عند سلامة التأسيس ، كل الشكر والتقدير والاحترام لك 😇 سأحاول غداً إن شاء الله تعالى لتلبية مطلبك الجديد

وعليكم السلام ورحمة الله تعالى وبركاته اخي @أبو أحمد ، تفضل الكود التالي بعد تعديل المسميات في مثالك. Private Sub أمر26_Click() On Error GoTo ErrorHandler Dim db As dao.Database Dim rst1 As Recordset, rst2 As Recordset Dim fld As Field Dim sqlUpdate1 As String, sqlUpdate2 As String Dim recordID As Long If Me.searinumber = 0 Or IsNull(Me.searinumber) Or Me.searinumber = "" Then MsgBox "الرجاء إدخال رقم السجل", vbExclamation Me.searinumber.SetFocus Exit Sub End If recordID = Val(Me.searinumber) Set db = CurrentDb() If DCount("*", "جدول تسجيل الكتب", "searinumber = " & recordID) = 0 Then MsgBox "رقم السجل غير موجود", vbExclamation Me.searinumber.SetFocus GoTo ExitSub End If Set rst1 = db.OpenRecordset("جدول تسجيل الكتب") 'الجدول الرئيسي sqlUpdate1 = "UPDATE [جدول تسجيل الكتب] SET " For Each fld In rst1.Fields If fld.Name <> "searinumber" Then 'المفتاح الأساسي If Not (fld.Attributes And dbAutoIncrField) Then sqlUpdate1 = sqlUpdate1 & "[" & fld.Name & "] = Null, " End If End If Next fld If Right(sqlUpdate1, 2) = ", " Then sqlUpdate1 = Left(sqlUpdate1, Len(sqlUpdate1) - 2) sqlUpdate1 = sqlUpdate1 & " WHERE searinumber = " & recordID End If Set rst2 = db.OpenRecordset("Marks") 'الجدول الفرعي sqlUpdate2 = "UPDATE Marks SET " For Each fld In rst2.Fields If fld.Name <> "NoMArks" Then 'الحقل المرتبط If Not (fld.Attributes And dbAutoIncrField) Then sqlUpdate2 = sqlUpdate2 & "[" & fld.Name & "] = Null, " End If End If Next fld If Right(sqlUpdate2, 2) = ", " Then sqlUpdate2 = Left(sqlUpdate2, Len(sqlUpdate2) - 2) sqlUpdate2 = sqlUpdate2 & " WHERE NoMArks = " & recordID End If db.Execute sqlUpdate1 db.Execute sqlUpdate2 MsgBox "تمت تصفية بيانات السجل رقم " & recordID & " في الجدولين", vbInformation Me.Requery ExitSub: If Not rst1 Is Nothing Then rst1.Close If Not rst2 Is Nothing Then rst2.Close Set rst1 = Nothing Set rst2 = Nothing Set db = Nothing Exit Sub ErrorHandler: MsgBox "حدث خطأ", vbCritical Resume ExitSub End Sub

أنا مش خايف يا عسل أنا قلت أنوِّه بس ، للتذكير ليس إلا

وعليكم السلام ورحمة الله تعالى وبركاته استخدم الدالة التالية في مديول :- Function GetAcademicYear() As String Dim currentDate As Date Dim currentYear As Integer Dim nextYear As Integer currentDate = Date currentYear = Year(currentDate) nextYear = currentYear + 1 If currentDate >= DateSerial(currentYear, 9, 1) Then GetAcademicYear = currentYear & " - " & nextYear Else GetAcademicYear = (currentYear - 1) & " - " & currentYear End If End Function في مربع النص اجعل مصدر بياناته = =GetAcademicYear() وتقدر تستخدمه في استعلام على سبيل المثال ، بالشكل التالي :- SELECT IIf(Date() >= DateSerial(Year(Date()), 9, 1), Year(Date()) & " - " & (Year(Date()) + 1), (Year(Date()) - 1) & " - " & Year(Date())) AS AcademicYear; النتيجة :- 1️⃣ إذا كان التاريخ الحالي بعد أو يساوي 1 سبتمبر 2024 ، ستكون النتيجة 2024 - 2025 2️⃣ إذا كان التاريخ الحالي قبل 1 سبتمبر 2024 ، ستكون النتيجة 2023 - 2024 🔚 بهذه الطريقة ، يمكنك الحصول على السنة الدراسية الحالية والسنة اللاحقة بناءً على التاريخ المحدد AcademicYear.accdb

في الكود الأخير لي ، لا أعتقد أنه يوجد نهاية للترقيم ❗ من -2,147,483,648 إلى 2,147,483,647 Dim maxNum As Long

ربي يخليك ويسعدك ، بالعكس دا انا اللي بحب أستنير بأفكاركم العظيمة ،

مساهمتي المتواضعة مع الأساتذة ، وتقصيراً لكود المهندس @ابو جودي ، Public Function FlexiBranchSerial(tableName As String, serialField As String, branchCode As String) As String On Error GoTo ErrorHandler If Trim(tableName & serialField & branchCode) = "" Then FlexiBranchSerial = "خطأ: مدخلات غير صالحة" Exit Function End If Dim db As DAO.Database Dim maxNum As Long Dim sql As String Dim qdf As QueryDef Set db = CurrentDb sql = "SELECT Max(Val(Left([" & serialField & "], InStr([" & serialField & "],'/') - 1))) AS MaxNum " & _ "FROM " & tableName & " WHERE [" & serialField & "] LIKE '*" & branchCode & "'" Set qdf = db.CreateQueryDef("", sql) maxNum = Nz(qdf.OpenRecordset()(0), 0) + 1 FlexiBranchSerial = Format(maxNum, "00") & "/" & branchCode Set qdf = Nothing Set db = Nothing Exit Function ErrorHandler: FlexiBranchSerial = "خطأ: فشل في توليد الرقم" End Function الإستدعاء :- Private Sub Specialty_AfterUpdate() DoctorID = FlexiBranchSerial("tblDoctors", "DoctorID", Specialty.Column(2)) End Sub ترقيم تلقائي حسب الفرع.accdb جميل جداً ، للخبرة دور في ترك أثر عظيم يدل على ركازة التفكير أبدعتم معلمنا الحبيب

وعليكم السلام ورحمة الله وبركاته .. طلبك يا صديقي غير واضح ، فما هي الشروط التي على أساسها سيتم تحديد القسط والمدة ( الشرط الذي على أساسه سيتم تحديد نوع الإلتزام ) ؟؟ لنفترض في السجل رقم 50 ، كيف سيتم تحديد القيم التي تريد جلبها وأين تريد إضافة المدة ( في أي خلية ) اذا اعتمدنا ان MAX Installment limit = قيمة القسط على سبيل المثال .

بداية استخدم فكرة الأستاذ @أ / محمد صالح لحفظ ورقة العمل بصيغة PDF في هذه المشاركة هنا . أما فيما يتعلق بفكرة الارسال برسالة واتس أب من خلال اكسل فأعتقد الموضوع له تشعبات كثيرة ، ويحتاج للتحديث دائماً ؛ السبب هو تغيير سياسة الارسال في واتس اب ( الموقع او تطبيق ويندوز ) .

أخي الكريم أهلا وسهلاً بك .. بدايةً لا بد أن أوضح لك أن اللغة العربية في المسميات للجداول ةالحقول ستخلق لك صعوبات ومشاكل في كتابة الأكواد والاستعلامات ... إلخ . أضف إلى ذلك أنك تستخدم أسماء عربية مكونة من أكثر من كلمة وتفصل بينها مسافات وليس إشارة "_" على سبيل المثال .. على العموم ، في أسماء الجداول أو الحقول التي تتكون من أكثر من كلمة عربية وتفصل بينها مسافة استخدم علامتي الـ "" ، وفي أسماء الحقول . جرب هذا التعديل ، أو أعانك الله على ارسال قاعدة بيانات تحتوي الجدولين فقط بدون سجلات حساسة أو شخصية Private Sub Command0_Click() On Error GoTo ErrorHandler Dim db As DAO.Database Dim rst1 As DAO.Recordset, rst2 As DAO.Recordset Dim fld As DAO.Field Dim sqlUpdate1 As String, sqlUpdate2 As String Dim رقم_الكتاب As Long If Me.رقم_البحث = 0 Or IsNull(Me.رقم_البحث) Or Me.رقم_البحث = "" Then MsgBox "الرجاء إدخال رقم الكتاب", vbExclamation Me.رقم_البحث.SetFocus Exit Sub End If رقم_الكتاب = Val(Me.رقم_البحث) Set db = CurrentDb() If DCount("*", "جدول_الموظفين", "رقم_الموظف = " & رقم_الكتاب) = 0 Then MsgBox "رقم الكتاب غير موجود", vbExclamation Me.رقم_البحث.SetFocus GoTo ExitSub End If Set rst1 = db.OpenRecordset("جدول_الموظفين") sqlUpdate1 = "UPDATE جدول_الموظفين SET " For Each fld In rst1.Fields If fld.Name <> "معرف_الموظف" Then ' المفتاح الأساسي If Not (fld.Attributes And dbAutoIncrField) Then sqlUpdate1 = sqlUpdate1 & "[" & fld.Name & "] = Null, " End If End If Next fld If Right(sqlUpdate1, 2) = ", " Then sqlUpdate1 = Left(sqlUpdate1, Len(sqlUpdate1) - 2) sqlUpdate1 = sqlUpdate1 & " WHERE رقم_الموظف = " & رقم_الكتاب End If Set rst2 = db.OpenRecordset("جدول_العلامات") sqlUpdate2 = "UPDATE جدول_العلامات SET " For Each fld In rst2.Fields If fld.Name <> "معرف_الموظف" Then If Not (fld.Attributes And dbAutoIncrField) Then sqlUpdate2 = sqlUpdate2 & "[" & fld.Name & "] = Null, " End If End If Next fld If Right(sqlUpdate2, 2) = ", " Then sqlUpdate2 = Left(sqlUpdate2, Len(sqlUpdate2) - 2) sqlUpdate2 = sqlUpdate2 & " WHERE رقم_الموظف = " & رقم_الكتاب End If db.Execute sqlUpdate1 db.Execute sqlUpdate2 MsgBox "تمت تصفية بيانات الموظف رقم " & رقم_الكتاب & " في الجدولين", vbInformation Me.جدول_العلامات.Requery ExitSub: If Not rst1 Is Nothing Then rst1.Close If Not rst2 Is Nothing Then rst2.Close Set rst1 = Nothing Set rst2 = Nothing Set db = Nothing Exit Sub ErrorHandler: MsgBox "حدث خطأ", vbCritical Resume ExitSub End Sub لاحظ أسماء الحقول والجداول كيف تم تعديلها بإشارة "_" ..

بناءً على رقم الخطأ 2505 ، قد يكون هناك خطأ في كود يفتح نموذج أو تقرير ضمن شروط معينة . ما لم تقم برفع ملف يحتوي المشكلة لمتابعتها بعيداً عن الإحتمالات التي قد تطول دون جدوى .

الشكر موصول للمهندس @Moosak ، هو صاحب الفكرة أخي الكريم ، ( قد اختلطت عليك الردود )

مداخلة .. بما انه عندك 3 ورديات ( صحيح ؟ ) الآن بعد ما تختار الوردية الثالثة - وبناءً على كلامك - ستواجه مشكلة وهو انه لا يوجد وردية رابعة !!!! وعليه فإنك ستعود للوردية الأولى صحيح ؟؟ اذاً يجب ان يكون هناك شروط عند فتح السجل الجديد للوردية الجديدة بأن تكون ضمن نفس تاريخ اليوم !!! ( هل هذا صحيح ؟؟ )

قمت بتثبيت نسخة أوفيس 2003 لمتابعة النتائج ، وهذه صورة للتوضيح للنتيجة :- المرفق :- Delete Records 1By1.mdb

حسناً ، جرب هذا التعديل ، كنت قد جهزته مسبقاً للإحتياط لهكذا رد . مع العلم أنني لا أملك أوفيس 2003 للأسف ، وعل أحد الأخوة ممن يملك هذا الإصدار إفادتنا بالنتيجة أيضاً .. Private Sub Command0_Click() On Error GoTo ErrorHandler Dim db As Database Dim rst As Recordset Dim fld As Field Dim sqlUpdate As String Dim tableName As String tableName = "Employee" 'اسم الجدول Set db = CurrentDb() Set rst = db.OpenRecordset(tableName) sqlUpdate = "UPDATE " & tableName & " SET " For Each fld In rst.Fields If fld.Name <> "EmployeeID" Then 'حقل المفتاح الأساسي If Not (fld.Attributes And dbAutoIncrField) Then sqlUpdate = sqlUpdate & "[" & fld.Name & "] = Null, " End If End If Next fld If Right(sqlUpdate, 2) = ", " Then sqlUpdate = Left(sqlUpdate, Len(sqlUpdate) - 2) db.Execute sqlUpdate MsgBox "تمت تصفية جميع البيانات باستثناء حقل المفتاح الأساسي", vbInformation Else MsgBox "لا توجد حقول يمكن مسح محتوياتها", vbExclamation End If ExitSub: If Not rst Is Nothing Then rst.Close Set rst = Nothing Set db = Nothing Exit Sub ErrorHandler: MsgBox "حدث خطأ", vbCritical Resume ExitSub End Sub 1. حيث ما تم تعديله هو حذف مرجعيات DAO من تعريفات الكائنات لأنها غير ضرورية في أكسس 2003 حسب علمي . 2. قمت بإضافة معالجة الأخطاء باستخدام On Error GoTo ErrorHandler . 3. قمت بحذف dbFailOnError لأنه غير ضروري مع وجود معالج الأخطاء . جرب وأخبرني بالنتيجة ,, جرب بدايةً على الحذف الكامل ، ثم ننتقل لحذف سجل محدد مع العلم ، هذا ردك على حذف سجل واحد مؤخراً

جرب هذا المرفق Delete Records.mdb

ليس لدي آكسيس 2003 ، ولكن على حد علمي ، تأكد من وجود مكتبة "Microsoft DAO 3.6 Object Library" اذا لم يعمل معك الكود ، رغم أن آكسيس 2003 يدعم DAO ( على حد علمي ، والله أعلم ) . على كل حال ، جرب الكود التالي ، ومتابع معك حتى تصل للنهاية .. Private Sub Command0_Click() Dim db As DAO.Database Dim rst As DAO.Recordset Dim fld As DAO.Field Dim sqlUpdate As String Dim tableName As String tableName = "Employee" 'اسم الجدول Set db = CurrentDb Set rst = db.OpenRecordset(tableName, dbOpenDynaset) sqlUpdate = "UPDATE " & tableName & " SET " For Each fld In rst.Fields If fld.Name <> "EmployeeID" Then 'حقل المفتاح الأساسي If (fld.Attributes And dbAutoIncrField) = 0 Then sqlUpdate = sqlUpdate & "[" & fld.Name & "] = Null, " End If End If Next fld If Right(sqlUpdate, 2) = ", " Then sqlUpdate = Left(sqlUpdate, Len(sqlUpdate) - 2) db.Execute sqlUpdate, dbFailOnError MsgBox "تمت تصفية جميع البيانات باستثناء حقل المفتاح الأساسي", vbInformation, "" Else MsgBox "لا توجد حقول يمكن مسح محتوياتها", vbExclamation, "" End If rst.Close Set rst = Nothing Set db = Nothing End Sub ملف للتطبيق :- Delete Records.accdb

المشكلة لم تظهر عندي حتى في أول مرفق لك صديقي العزيز.. عل أحد الإخوة ممن ظهرت لديه المشكلة ان يفيدك بأحد الحلول أو الإقتراحات المناسبة ..

يوجد كود لدي ، ولكنه يقوم بحذف جميع سجلات الجدول باستثناء حقل المفتاح الأساسي .. أم تريد حذف سجل محدد !!!!

في الأكواد لديك ، حاول ضبط التنسيق في المواضع التي يتم فيها اضافة التاريخ الى الحقل باستعمال الجملة :- Format(Date, "mm/dd/yyyy") كمثال في الجملة التالية :- Me.AwardMonth = Format(Date, "mm/dd/yyyy")

وعليكم السلام ورحمة الله وبركاته .. زودنا بملف بسيط على الأقل للتعرف على اسماء الحقول والجداول يا صديقي

أعتذر منك ، قد يكون لدى أحد الإخوة والأساتذة حل آخر

وعليكم السلام ورحمة الله وبركاته ،، فيما يتعلق بالمطلب الأول ، أعتقد انه يجب ضبط التنسيق للتاريخ في الدالة إن كانت هي المسؤولة عن الخلل الذي تتحدث عنها ، علماً أنني لم ألحظ الخطأ بشكل واضح . على العموم في الدالة داخل المديول جرب ضبط التنسيق للسطر بالشكل التالي :- txtDate = Format(Date, "mm/dd/yyyy") المطلب الثاني غير مفهوم بالنسبة لي ..

جرب هذا التعديل البسيط ra1 (2).accdb

تم تعديل اسلوب الدالة من المديول على النحو التالي :- Function CalculateFridaysSaturdays(monthName As String, Optional baseYear As Integer = 0, Optional dayType As String = "Both") As Variant Dim monthNumber As Integer Dim startDate As Date, endDate As Date Dim fridays As Integer, saturdays As Integer Dim targetYear As Integer monthName = Trim(monthName) Select Case monthName Case "يناير": monthNumber = 1 Case "فبراير": monthNumber = 2 Case "مارس": monthNumber = 3 Case "ابريل": monthNumber = 4 Case "مايو": monthNumber = 5 Case "يونيو": monthNumber = 6 Case "يوليو": monthNumber = 7 Case "اغسطس": monthNumber = 8 Case "سبتمبر": monthNumber = 9 Case "اكتوبر": monthNumber = 10 Case "نوفمبر": monthNumber = 11 Case "ديسمبر": monthNumber = 12 Case Else CalculateFridaysSaturdays = "اسم الشهر غير صحيح" Exit Function End Select If monthNumber >= 10 Then targetYear = year(Date) - 1 ElseIf monthNumber <= 6 Then targetYear = year(Date) Else targetYear = baseYear End If If targetYear < 1900 Or targetYear > 2100 Then CalculateFridaysSaturdays = "السنة غير صحيحة" Exit Function End If fridays = CountWeekdayOccurrences(targetYear, monthNumber, vbFriday) saturdays = CountWeekdayOccurrences(targetYear, monthNumber, vbSaturday) Select Case LCase(dayType) Case "friday": CalculateFridaysSaturdays = fridays Case "saturday": CalculateFridaysSaturdays = saturdays Case Else: CalculateFridaysSaturdays = Array(fridays, saturdays) End Select End Function Function CountWeekdayOccurrences(targetYear As Integer, monthNumber As Integer, targetWeekday As Integer) As Integer Dim startDate As Date, endDate As Date Dim firstDay As Integer, totalDays As Integer Dim count As Integer startDate = DateSerial(targetYear, monthNumber, 1) endDate = DateSerial(targetYear, monthNumber + 1, 0) firstDay = Weekday(startDate) totalDays = endDate - startDate + 1 count = ((totalDays + firstDay - targetWeekday) \ 7) + IIf((firstDay <= targetWeekday), 1, 0) CountWeekdayOccurrences = count End Function ✅ تحسين قراءة أسماء الأشهر بحيث لا تتأثر بالمسافات الزائدة . ✅ إضافة فحص للسنة لمنع القيم غير المنطقية . ✅ تحسين الأداء باستخدام دالة تقوم بالحساب المباشر . ✅ تجنب الأخطاء عند تمرير قيم غير صحيحة أو عند التعامل مع أسماء الأشهر . ✅ تحديث الاستعلام SQL بحيث يستبعد القيم غير الصالحة (NULL أو الفراغ) . 👌 النتيجة : كود أسرع وأكثر كفاءة ويعمل دون أخطاء غير متوقعة بهذه الطريقة ، لن تحتاج إلى تغيير الكود يدوياً كل سنة ، وسيتم احتساب القيم المطلوبة تلقائياً !! أما الإستعلام ، فقد تم تعديله لمحاكاة الكود السابق على النحو التالي :- UPDATE data_shr SET gm = CalculateFridaysSaturdays([shr], 0, "Friday"), sbt = CalculateFridaysSaturdays([shr], 0, "Saturday") WHERE shr IN ("يناير", "فبراير", "مارس", "ابريل", "مايو", "يونيو", "اكتوبر", "نوفمبر", "ديسمبر") AND shr IS NOT NULL AND shr <> ""; ايام الغياب 2.accdb * تم حذف الأجزاء السابقة الغير ضرورية لتلافي ظهور رسائل الأخطاء .