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

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