Moosak

تم التعديل تفضل أخي AMINYOUSIF الكود بعد التعديل : Me.Refresh DoCmd.SetWarnings False DoCmd.OpenQuery "UPDATA_PRICE_CLASS_YES" DoCmd.SetWarnings True Me.F_PRICE_CLASS.Requery UP_PRICE.rar

شكرا أبا جودي

ياريت تدعمنا بالصور من برنامجك السابق باش مهندس 😊

شكرا لك أخي أبا عبدالرحمن .. هذا إنعكاسة خلقك الطيب 🙂

نعم يا أبا عبدالرحمن ... في الفورم حقل غير منظم به الدالة السابقة .. وبعد تحديث حقلي التاريخ وعند الحالي للنموذج : Private Sub Form_Current() Me.الشهر = Me.MothDiffNum Me.Refresh End Sub Private Sub تاريخ_الاستحقاق_AfterUpdate() Me.الشهر = Me.MothDiffNum End Sub Private Sub تاريخ_اليوم_AfterUpdate() Me.الشهر = Me.MothDiffNum End Sub طرح بين تاريخيين.accdb

يمكنك استخدام هذه الدالة ولكن في استعلام وليس في الجدول : DateDiff("m";[تاريخ الاستحقاق];[تاريخ اليوم]) تعطيك فارق الأشهر بين التاريخين هكذا : طرح بين تاريخيين.accdb

اللهم آمين وإياك يا زعيم الأغلبية 😊🤲🏻

(وفوق كل ذي علم عليم) 😅✋🏻 ومنك نتعلم حبيبنا 😄 عملت الموديول هذا من زمان بهدف أنه لما يكون عندي مرفقات مثلا أو ملفات مصاحبة للبرنامج تروح على طول جنب قاعدة البيانات سواء مقسمة ولا لا .. بدون ما أغير كل مرة في الكود 🙂 لكن شكلي هحدثه بالكود بتاعك شكله رشيق ودلع 😁

وعليكم السلام ورحمة الله وبركاته .. 🙂 ضع هذا الكود في موديول : Public Function BECurrentPath() On Error GoTo ErrHandler Dim FullLinkedPath As String Dim LinkedDBPath As String FullLinkedPath = Nz(DFirst("database", "msysobjects", "[Database]<> '""'"), "") LinkedDBPath = Left(FullLinkedPath, InStrRev(FullLinkedPath, "\") - 1) If FullLinkedPath <> "" Then BECurrentPath = LinkedDBPath & "\" Else BECurrentPath = CurrentProject.Path & "\" End If ErrHandler: If Err.Number = 0 Then Exit Function Else MsgBox "Error Number : " & Err.Number & " :::: " & Err.Description End Function ثم أكتب في مصدر بيانات مربع النص : =BECurrentPath()

الأمور شغالة تمام معانا 🙂

اللهم آمين وإياكم أخي نبيل

جرب الآن أخي صابر .. أضفت لك زر للسماح بالتحرير محمي بكلمة مرور .. كلمة المرور : 123456789 ويمكنك تغييرها من حدث عند النقر للزر هنا : Private Sub AllowEditCmd_Click() If AllowMeEditing = False Then If InputBox("أدخل كلمة المرور للسماح بالتعديل", "خاص بالإدارة") = "123456789" Then Me.AllowEdits = True AllowMeEditing = True Me.sheet_on_line2.Enabled = True Me.AllowEditCmd.Caption = "منع التحرير" MsgBox "تم السماح بالتحرير", vbOKOnly, "" Else MsgBox "كلمة المرور خاطئة", vbOKOnly, "" Exit Sub End If ElseIf AllowMeEditing = True Then DoCmd.RefreshRecord Me.AllowEdits = False AllowMeEditing = False Me.sheet_on_line2.Enabled = False Me.AllowEditCmd.Caption = "السماح بالتحرير" DoCmd.OpenForm "tasgeel_invioce" End If End Sub ولمنع التحرير مجددا تضغط على نفس الزر be (1).rar

تفضل يا صابر .. be (1).rar

جرب الآن أخي نبيل .. nabilali.accdb

تفضل أخي صابر .. جرب وأخبرنا بالنتيجة 🙂 be (1).rar

ممكن ترفق ملف الأكسل أخي نبيل ؟

أخي صابر يمكنك الاىستغناء عن وضعه في جميع العناصر بوضعه في حدث بعد التحديث للنموذج 🙂 أتمنى منك أن تزيلها وتعيد إرفاق الملف من جديد لأنها مزعجة وصعب علينا أن نتتبعها في جميع العناصر .. فأهل مكة أدرى بشعابها 😏

العفو أخي عبده 🙂

سبقني إليها الأستاذ د.كاف يار أثناء اشتغالي بها ما شاء الله عليه 🙂 هذه محاولتي .. جعلتها في دالة واحدة للفصلين ، وأضطررت لإضافة حقل ترقيم تلقائي في كلا الجدولين للتأكد من وجود رقم مميز لكل سجل وعدم اختلاط النتائج .. 🙂 Public Function FinalResult(ID As Long, TblFinal As String) As String Dim x As Integer: x = 0 Dim n As String Dim TR1 As Double Dim TR2 As Double Dim TR3 As Double Dim TR4 As Double Dim TR5 As Double Dim TR6 As Double Dim DB As DAO.Database Dim RS As DAO.Recordset Set DB = CurrentDb Set RS = DB.OpenRecordset("select * from " & TblFinal & " where [AutoNum] = " & ID & " ;") TR1 = RS!TR1 TR2 = RS!TR2 TR3 = RS!TR3 TR4 = RS!TR4 TR5 = RS!TR5 TR6 = RS!TR6 If TR1 < 50 Then x = x + 1 If TR2 < 50 Then x = x + 1 If TR3 < 50 Then x = x + 1 If TR4 < 50 Then x = x + 1 If TR5 < 50 Then x = x + 1 If TR6 < 50 Then x = x + 1 Select Case TblFinal Case "TBL_Final1" If x >= 1 Then n = "دور ثان" Else n = "ناجح" End If FinalResult = n Case "TBL_Final2" If x > 0 And x < 3 Then n = "مكمل" ElseIf x >= 4 Then n = "باقٍ للإعادة" ElseIf n = 0 Then n = "ناجح" End If FinalResult = n End Select RS.Close Set DB = Nothing Set RS = Nothing End Function والنتيجة في العمود الأخير لكلا الاستعلامين .. احتساب النتيجة عن طريق وحدة نمطية.mdb

أهلا أخي الحلبي .. هذا تصميم عملته بالفوتوشوب وضعته كخلفية للفورم وركبت عليه زر مخفي 🙂 وطبعا مربعات اسم المستخدم وكلمة المرور بدون حدود والخلفية باللون الأبيض أو شفاف

يمكنك التحايل على البرنامج والإبداع بطريقة اللعب بالألوان والخطوط .. هكذا على سبيل المثال 🙂 :

حياك الله أخي صابر .. أين وضعت الدالة التي ذكرتها ؟ على أي زر ؟ ولدي سؤال : لماذا وضعت أمر تشغيل استعلام التحديث على جميع العناصر ؟؟ !! ألا يبدوا لك الأمر مزعجا مع الكم الهائل من رسائل تأكيد تشغيل الاستعلام ؟؟ 🙂 ربما أوقفت تشغيل الرسائل من خيارات البرنامج عندك .. لكن تظهر عند الآخرين .

الملف المرفق فارغ أخي عمران .. لا تظهر الجداولا ولا الاستعلامات ..

ضع هذا الكود بدل السابق أخي عبده : On Error GoTo ErrHandler Dim y As Integer, x As Integer: x = Me.Form.Recordset.RecordCount Me.AllowAdditions = False DoCmd.RunCommand acCmdSelectAllRecords DoCmd.RunCommand acCmdCopy Me.AllowAdditions = True DoCmd.GoToRecord , , acNewRec DoCmd.RunCommand acCmdPaste DoCmd.GoToRecord , , acLast For y = 1 To x Me.Month = "" DoCmd.GoToRecord , , acPrevious Next ErrHandler: If Err.Number <> 0 Then MsgBox Err.Number & " \\\\\ " & Err.Description Me.AllowAdditions = True Else Exit Sub End If

بعد البحث وجدت خبرا جديدا .. أن جوجل سوف توقف خدمة الإرتباط بالبريد الإلكتروني عن طريق ( التطبيقات الأقل أمانا ) كما يسمونها .. وأحدها هذه الطريقة 😞 https://support.google.com/accounts/answer/6010255?hl=ar#zippy=%2Cفي-حال-كانت-إعدادات-وصول-التطبيقات-الأقل-أمانا-مفعلة-على-حسابك لذلك سيكون البديل هو العودة إلى الآوتلوك من جديد .. حتى يظهر لنا حل آخر للوصول إلى الجيميل ..