Foksh

تفضل أخي @gavan الملف المرفق يحتوي معه البرنامج المستخدم في سحب الصور من السكانر . تحميل الملف

مشاركة مع الاستاذ @kkhalifa1960 موجود عندي نسخة معدلة تعمل على سحب الصور من السكانر و الفيدر وحفظها بصيغة Pdf . انتظرني حتى أصل العمل وسأرفقها لك إن شاء الله.

استغفر الله اخي الكريم ، ثم يأتيك الله بالفرج ، فلا تقلق 🤗

فرج الله همك أخوي الغالي ، ولا يهمك ، وترى انا ما قلت لك تقسم القاعدة انشئ قاعدة جديدة فارغة وانشئ فيها جدول بنفس الحقول ، وانسخ 15 اذا اردت من السجلات فقط . يطلع حجمها 2 ميجا تقريباً

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

تفضل محاولتي أخي الكريم @husseinharby ,, ولا أعلم أن كنت قد فهمتك بشكل صحيح ,, Database2.accdb

وين المرفق أخوي

Private Sub Form_Open(Cancel As Integer) ' منع التعديل Me.AllowEdits = False End Sub

قيمة low و high موجودين في النموذج ؟؟ لم أقم بفتح المرفق للإطلاع عليه 😊

متابع ..

انسخ في جدول جديد وقاعدة بيانات جديده عدد من السجلات العشوائية ( 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 تمت تجربة الملف المرفق ، وقام بإنشاء نسخة احتياطية بشكل طبيعي عند الإغلاق بدون أي مشاكل . مع العلم أنه لا يوجد جداول مرتبطة بقاعدة أخرى 🙄