Foksh

كنت سابقاً قد اعتمدت في محاولة التفعيل عن بعد لبرنامجي على مثل هذه الفكرة ، لذا جرب هذا الكود عله يفيدك Private Sub CommandButton_Click() Dim filePath As String Dim fileContent As String ' تحديد معرف الملف على Google Drive filePath = "https://drive.google.com/uc?export=download&id=1KMBf9MxyB7gnrjev2TXkPUbZDuwXK12i" ' قراءة محتوى الملف fileContent = GetFileContent(filePath) ' وضع قيمة الملف في مربع النص Me.Textbox.Value = fileContent End Sub Function GetFileContent(filePath As String) As String Dim xmlHTTP As Object Set xmlHTTP = CreateObject("MSXML2.ServerXMLHTTP") ' إرسال طلب HTTP للحصول على الملف xmlHTTP.Open "GET", filePath, False xmlHTTP.send ' إرجاع محتوى الملف كنص GetFileContent = xmlHTTP.responseText End Function وحيث أن CommandButton هو اسم الزر في نموذجك. و Textbox هو اسم مربع النص الذي سيتم جلب القيمة له من الملف.

هات مرفق 😊

ألا وهو !!

انا قمت بشرح العملية بالخطوات الـ 4 ، لكن عند التنفيذ يتم تنفيذها بجملة حسابية واحدة (710-70)-(32-8) = 616

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

1. انت قمت بشراء 710 وقمت بمرتجع 70 يصبح الشراء ( 710 - 70 = 640 ) 2. قمت ببيع 32 ، ومرتجع بقيمة 8 يصبح البيع ( 32 - 8 = 24 ) 3. المشتريات - المبيعات = مبلغ البضاعة في المخزن 4. ( 640 - 24 = 616 ) هذا على حسب ما فهمت 😅

في محاولة سابقة مني ، حاولت إنشاء قاعدة بيانات تحاكي ChatGPT بإن يتم طرح سؤال ، ويتم الرد على السؤال داخل النموذج 😅 لا أريد أن أشجع أو أحبط آمالي ؛ لكن المشروع كان ولا زال يحتاج عمل ومتابعة حتى يتم إنتاجه .. سأحاول طرح الموضوع في موضوع مستقل ومشاركة الأساتذة خبراتهم للخروج بـ AccessGPT 😁

تفضل أخي @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