Moosak

السلام عليكم ورحمة الله وبركاته .. تحية طيبة إخواني .. 🌹 أحضرت لكم اليوم كود وظيفته استخراج الملفات المخزنة في جداول الأكسس كمرفقات داخلية إلى خارج قاعدة البيانات دفعة واحدة 🙂 وهو مفيد جدا لمن لديه قاعدة بيانات قد ملئها بالمرفقات ويحاول الآن تصغير القاعدة باستخراج المرفقات منها وحفظها خارج قاعدة البيانات بسهولة ويسر .. بدل حفظها ملف ملف وهي عملية مرهقة بالتأكيد .. خصوصا إذا كان عدد المرفقات بالمئات .. إليكم الكود : Public Function ExtractAllAttachments(ByVal TableName As String, ByVal AttchmentColumnName As String, ByVal ExtractToFolder As String) ' TableName : اسم الجدول ' AttchmentColumnName : اسم حقل المرفقات ' ExtractToFolder: المكان المراد استخراج الملفات إليه مثال : "C:\ExtractHere" Dim RsMainrecords As dao.Recordset2 Dim RsAttachments As dao.Recordset2 Set RsMainrecords = CurrentDb.OpenRecordset("select " & AttchmentColumnName & _ " from " & TableName & _ " where " & AttchmentColumnName & ".FileName is not Null") Do Until RsMainrecords.EOF Set RsAttachments = RsMainrecords.Fields(AttchmentColumnName).Value Do Until RsAttachments.EOF Dim OutputFileName As String OutputFileName = RsAttachments.Fields("FileName").Value OutputFileName = ExtractToFolder & "\" & OutputFileName RsAttachments.Fields("FileData").SaveToFile OutputFileName RsAttachments.MoveNext Loop RsAttachments.Close RsMainrecords.MoveNext Loop RsMainrecords.Close Set RsMainrecords = Nothing Set RsAttachments = Nothing End Function ويتم تشغيله بالطريقة التالية : ExtractAllAttachments("TableName","AttchmentColumnName","ExtractToFolder") ستحتاج لإعطائه 1- اسم الجدول ، 2 - اسم الحقل ، 3 - المكان الذي تريد استخراج المرفقات فيه . المصدر : https://www.youtube.com/watch?v=jHIgay9goWo

شكرا لك أخي عبدالقدوس 🙂

تم التعديل تفضل أخي 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

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

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

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

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