Foksh

انسخ في جدول جديد وقاعدة بيانات جديده عدد من السجلات العشوائية ( 50سجل فرضاً ) ، وارفق الجدول 😁 بلاش 2 جيجا 😅

ده ناتج عن حذف السجلات ، والترقيم التلقائي لا يقوم بتعويض الفاقد ، واذا كان حقل الترقيم مفتاح أساسي مع جداول أخرى فإنك ستواجه مشكله لو حاولت ترتب السجلات بتعويض الفاقد ، وكحل للحقول اللاحقة ( يعني لو فرضاً عندك السجل رقم 8000 وحذفته ورجعت سجلت سجل آخر جديد سيصبح الترقيم 8001 مع العلم ان 8000 تم حذفه ) استخدم الدالة Dmax لإضافة رقم حسب آخر رقم موجود في الحقل في الجدول 😅

تفضل معلمي الفاضل ، مشاركتي الجانبية --------------------------- استأذنك استاذي foksh في التعديل لاضافة الدالة هنا من اجل تكون قريبة لطلاب العلم Public Function GetTableNameFromComboBox(cbo As ComboBox) As String On Error Resume Next Dim strTableName As String Dim ctl As Control Set ctl = cbo If Not ctl.RowSourceType = "" And Not ctl.RowSource Like "SELECT*" Then Exit Function End If If ctl.RowSourceType = "Table/Query" Then Dim queryParts As Variant queryParts = Split(ctl.RowSource, "FROM ") If UBound(queryParts) > 0 Then strTableName = queryParts(1) strTableName = Left(strTableName, InStr(strTableName, ";") - 1) If InStr(strTableName, "ORDER BY") > 0 Then strTableName = Left(strTableName, InStr(strTableName, "ORDER BY") - 1) End If End If ElseIf ctl.RowSourceType = "Value List" Then strTableName = "Value List" End If GetTableNameFromComboBox = Trim(strTableName) End Function DataUp1.accdb

في لهجتنا الاردنية يقولوا :- لما الخلِّيط يُخلُط .. إنسى الموضوع 😂 استاذنا ومعلمنا الجليل قدها وقدود ، ما شاء الله عليك 🤗

معلمي الفاضل وأستاذنا القدير أبو خليل ، بداية ما زلت في قمة الشباب وثانياً يسعدني مشاركتك هذا الموضوع DatabaseUp8.accdb دائماً سبااااااق في الحلول أستاذنا @Moosak

بعض ما عندكم أخي سامر 🤗

مشاركة جانبية ،، جرب هذه الفكرة اعتماداً على كودك Private Sub Form_Open(Cancel As Integer) Dim expirationDate As Date expirationDate = #12/28/2023# If Not IsDateValid(expirationDate) Then MsgBox "تم اكتشاف تلاعب بتاريخ الجهاز." & vbCrLf & vbCrLf & _ "يرجى الاتصال بمصمم البرنامج." & vbCrLf & vbCrLf & _ "سامر محمود تليفون", vbOKOnly + vbMsgBoxRight + vbExclamation DoCmd.Quit End If If Now > expirationDate Then MsgBox "حدث عطل فني" & vbCrLf & vbCrLf & _ "يرجى الاتصال بمصمم البرنامج." & vbCrLf & vbCrLf & _ "سامر محمود تليفون", vbOKOnly + vbMsgBoxRight + vbExclamation DoCmd.Quit End If End Sub Function IsDateValid(testDate As Date) As Boolean ' تحقق من أن التاريخ لم يتم تلاعب به بشكل كبير (تأخير طويل جدا) Const MaxDelayDays As Integer = 7 IsDateValid = Abs(DateDiff("d", Now, testDate)) <= MaxDelayDays End Function الكود الأول بالإعتماد على مدة محددة للتلاعب ،، والكود التالي بدون تحديد مدة Private Sub Form_Open(Cancel As Integer) Dim expirationDate As Date expirationDate = #12/28/2023# If Not IsDateValid(expirationDate) Then MsgBox "تم اكتشاف تلاعب بتاريخ الجهاز." & vbCrLf & vbCrLf & _ "يرجى الاتصال بمصمم البرنامج." & vbCrLf & vbCrLf & _ "سامر محمود تليفون", vbOKOnly + vbMsgBoxRight + vbExclamation DoCmd.Quit End If If Now > expirationDate Then MsgBox "حدث عطل فني" & vbCrLf & vbCrLf & _ "يرجى الاتصال بمصمم البرنامج." & vbCrLf & vbCrLf & _ "سامر محمود تليفون", vbOKOnly + vbMsgBoxRight + vbExclamation DoCmd.Quit End If End Sub Function IsDateValid(testDate As Date) As Boolean ' التحقق من أن التاريخ لم يتم تلاعب به IsDateValid = (DateDiff("d", Now, testDate) >= 0) End Function

تفضل التعديل الكامل Rac.accdb

أخي الكريم @husseinharby ضع هذا الشرط في الاستعلام عند حقل التاريخ DMax("reg_date","[table1]")

أخي الكريم ، سيتم حفظ الملف في مكان قاعدة البيانات ، أما إذا أردت تخصيص مكان آخر ، فتفضل الكود التالي :- Dim strPath As String strPath = "D:\NRc\Aracestbl.xls" DoCmd.OutputTo acOutputTable, "Aracestbl", acFormatXLS, strPath, True, , , acExportQualityPrint

أخي الكريم @ابو عبد الله العراقي استبدل هذا الكود في الزر المسؤول عن التصدير On Error GoTo com: Dim filePath As String filePath = CurrentProject.Path & "\Aracestbl.xls" DoCmd.OutputTo acOutputTable, "Aracestbl", acFormatXLS, filePath, True, , , acExportQualityPrint com: MsgBox Err.Description وهذا الملف بعد التعديل Rac.accdb

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

ارسل مرفق أخي الكريم للعمل عليه 😊

أخي الكريم @moho58 تمت تجربة الملف المرفق ، وقام بإنشاء نسخة احتياطية بشكل طبيعي عند الإغلاق بدون أي مشاكل . مع العلم أنه لا يوجد جداول مرتبطة بقاعدة أخرى 🙄

اذاً اخي الكريم طبق نفس الفكرة على حقل الوقت ما تم تطبيقه على حقل التاريخ 😊 استخدم الدالة Dmax

لا تحتار وإنت في منتدانا 😊 اذا استطعت انسخ قاعدة البيانات واخذف الأمور الخاصة واترك فقط الفورم المسؤول عن كود النسخ الاحتياطي ، وأرسله.

هل يوجد حقل للوقت في الجدول ؟؟ اذا كان لا ، فهنا تحتاج هذا الحقل وسيكون مفيداً لك في البحث والاستعلام.

تفضل أخي الكريم هذا التعديل البسيط ، تم الأخذ بعين الإعتبار الإضافة أو التعديل ، وستلاحظ ذلك أثناء التطبيق . تم الاستغناء عن المديول القديم والماكرو ايضاً . 88.accdb

مشاركة مع الأستاذ @محمد السيسي تفضل أخي @moho58 ، كان السبب أعتقد أن الكود لم يقوم بإنشاء المجلد Backup من تلقاء نفسه ، تم التعديل وحل المشكلة . هذا المرفق تم تعديله . Backup 2024.zip

تفضل أخي ، لعلي أكون قد فهمت طلبك جيداً هذه طريقتين ، واحدة استخدمت فيها Dmax ، والأخرى استخدمات فيها تاريخ اليوم الحالي Date مطعم وجبات.zip

لعدم توافر شبكة لتجربة الكود ، ولكن تفضل بتجربته هذا الكود ، وأعطاء النتيجة . Private Sub Form_BeforeUpdate(Cancel As Integer) Dim recordID As Integer Dim strSQL As String Dim rs As Recordset ' استخراج معرف السجل الحالي recordID = Me.Recordset.Fields("ID").Value ' قم بتغيير "ID" إلى اسم الحقل الخاص بمعرف السجل ' التحقق مما إذا كان هناك مستخدم آخر قد دخل إلى نفس السجل strSQL = "SELECT Count(*) AS RecordCount FROM YourTableName WHERE ID = " & recordID & " AND UserID <> " & Me.UserID Set rs = CurrentDb.OpenRecordset(strSQL) If rs.Fields("RecordCount").Value > 0 Then ' يوجد مستخدم آخر قد دخل إلى نفس السجل MsgBox "يوجد مستخدم آخر قد دخل إلى هذا السجل. لا يمكنك التحديث.", vbExclamation Cancel = True End If rs.Close Set rs = Nothing End Sub

أستاذي الفاضل ، استخدم زر إضافة الكود هذا ( <> ) لوضع الأكواد بشكل سليم في المشاركة . حتى نستطيع قراءة الكود بشكل صحيح. متابع بدون كمبيوتر في الوقت الحالي ، بسبب ظروف خاصة 😬

زماان كان في برامج تعتمد في تغيير اللغة على ملف txt يكون فيه مسميات الأزرار بالعربية في ملف تكست ، والإنجليزية في ملف تكست آخر ، وعند اختيار اللغة يتم استدعاء هذا الملف الخاص بهذه اللغة .

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

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