Foksh

أيضاً كفكرة تحويل الاشتراك الزمني الى نقاط ، يتم تحويل الاشتراك ولنفترض الذي مدته شهر أي بمعدل زيارة أو جلسة كل يوم أي بمعدل 30 زيارة بحيث يتم احتساب الزيارات التي استخدمها المشترك ولنفترض استخدم من مدة الاشتراك اسبوع أي بمعدل 7 زيارات فيتبقى له 23 زيارة ، وهنا عند تسجيله الدخول والخروج سيتم خصم 1 من عدد الـ 23 فيتبقى له 22 زيارة وهنا سيكون الإشعارات لديك نوعان :- - الإشتراكات المحدودة أو الزمنية يتم التنبيه قبل اسبوع مثلاً. - الإشتراكات الغير محدودة أو الرصيدية يتم التنبيه قبل 7 زيارات مثلاً متبقية في رصيد المشترك. وهنا لو غاب المشترك شهرين فإن رصيده لن يتأثر بمدة الإنقطاع . موضوع تحويل نوع الإشتراك أمر يسير بلا شك ، واحتساب الرصيد المتبقي أمر أيسر إن شاء الله عليكم 😇 . هي مجرد أفكار بصوت عالٍ 🤗 .

كانت فكرتي في برنامجي سابقاً ، انه يتم تسجيل الحضور من خلال رقم المشترك الغير متكرر . وعند طلب أحد المشتركين ايقاف اشتراكه بشكل مؤقت لأسباب كالسفر مثلاً ، كنت اقوم بتفعيل Pause كحقل موجود في جدول تفاصيل الإشتراك للمشترك ، بحيث انه لنفترض ان المشترك طلب ايقاف عضويته لمدة غير محددة . فمن خلال الزر المسؤول عن تحديث الحقل من No الى Yes لهذا المشترك يتم ايقاف العضوية بحيث لو تم ادخال رقم المشترك في لوحة تسجيل الحضور تظهر رسالة ان المشترك في فترة انقطاع ، وكان الأمر يعود للمسؤول بأنه عند ادخال رقم المشترك في نموذج عرض تفاصيل حساب مشترك ، يظهر له ان هذا الحساب متوقف مؤقتاً ، فيظهر زر إعادة تفعيل بحيث انه عند النقر عليه يتم إحتساب مدة الإنقطاع من تاريخ التوقيف ( وهي قيمة كان يحدثها زر إيقاف الإشتراك مؤقتاً ) الى تاريخ التفعيل ويتم اضافة هذه الايام الى مدة الاستراك + إعادة قيمة حقل الحالة من Yes الى No مرة أخرى . أي أن الحساب غير مجمد أو موقوف . هذه هي الفكرة الأفضل التي وجدتها أثناء العمل وهي احتساب عدد الأيام ولكن بشكل ديناميكي . أي أنه لو اراد المشترك اعادة ايقاف الاشتراك مؤقتاً مرة أخرى فسيقوم الكود بتحديث حقل تاريخ الإيقاف المؤقت و حقل حالة الإشتراك من No الى Yes مرة أخرى . أتمنى أن أكون قد وُفقت في توضيح الفكرة .

مشاركة مع المهندس @Moosak ، وتطبيقاً لفكرته بعين أخرى . قم بإنشاء مديول جديد ، والصق به الكود التالي مع تغيير القيم حسب حاجتك .. Public Function CalculateMargin(Amount As Double) As Double Select Case Amount Case Is <= 100 CalculateMargin = Amount * 0.05 Case 101 To 200 CalculateMargin = Amount * 0.1 Case 201 To 300 CalculateMargin = Amount * 0.15 Case 301 To 400 CalculateMargin = Amount * 0.2 Case 401 To 500 CalculateMargin = Amount * 0.25 Case 501 To 600 CalculateMargin = Amount * 0.3 Case 601 To 700 CalculateMargin = Amount * 0.35 Case 701 To 800 CalculateMargin = Amount * 0.4 Case 801 To 900 CalculateMargin = Amount * 0.45 Case Else CalculateMargin = Amount * 0.15 End Select End Function الآن من خلال استعلام تحديث ان كنت تريد تحديث قيمة الحقل "هامش الربح" في جدولك . أنشئ استعلام تحديث ( Update ) ، وقم باختيار الجدول "2025" ، ثم اختر الحقل الخاص بهامش الربح = "هامش الربح" ؛ الآن في خانة تحديث إلى ( Update To) سيتم استدعاء الدالة من المديول السابق :- CalculateMargin([Price]) والنتيجة :- يتم ضرب قيمة السعر في النسبة المئوية التي حددناها في المديول . وهذا مثال بملف مرفق على الفكرة .. Database1.accdb

موضوع التصميم يا صديقي هذا يعود لرؤيتك ونظرتك .. من ناحية التصميم يوجد الكثير من الأفكار التي قد تجدها في المنتدى . الأهم من ذلك هو فكرة البناء السليم للجداول ثم يتبعها النماذج وما يربطهم هو الاستعلامات أتمنى أن تجد أفكار تثير شغفك في ابتكار تصميم حديث ( إن صح التعبير )

اخي الكريم ، ليس عليك ارفاق المشروع كاملاً .. فقط العناصر ذات الصلة في الطلب ، وقم بضغط الملف باستعمال برامج الضغط المعروفة .

وعليكم السلام ورحمة الله وبركاته .. أخي الكريم @عبده الطوخى 1970 ، في زر البحث وفي نهاية الكود ، فقط اضف السطر التالي [Forms]![Frm_Data_entry]![Frm_Fatura_Main].[Form]![Net_Teams] = [Forms]![Frm_Data_entry]![Frm_Fatura_Main].[Form]![Total_Main_Meter] - [Forms]![Frm_Data_entry]![Frm_Fatura_Sub].[Form]![Total_Sub_Meter] وشوف النتيجة اذا صحيحة أو لأ

مشاركة ، ولا اعلم ان كانت صحيحة تفضل الملف المعدّل baseM_9 .accdb

اخي العزيز @sm44ms ، انت ما شاء الله عضو مميز ، ولا بد لك من معرفة قوانين المنتدى بإرفاق ملف و الأهم هو العنواااان . ان يكون ذا صلة واضحة لنوع الاستفسار . على العموم جرب هذه الفكرة Private Sub KH_Click() ' إعادة تعيين جميع المربعات لتكون فارغة ClearAllLists ' تعبئة القوائم للنماذج المختلفة عند الضغط على KH Me.lstForms1.AddItem "شاشة اصدار البطاقات;FO1" Me.lstForms2.AddItem "شاشة تجديد البطاقات;FO2" Me.lstForms3.AddItem "شاشة تعديل بيانات البطاقات;FO3" Me.lstForms4.AddItem "شاشة تعديل بيانات اساسية فرعية;FO4" Me.lstForms5.AddItem "شاشة اصدار بطاقات المتقاعدين;FO5" Me.lstForms6.AddItem "شاشة البطاقات المنتهية;FO6" Me.lstForms7.AddItem "شاشة الملف الشخصي العام;FO7" End Sub Private Sub TW_Click() ' إعادة تعيين جميع المربعات لتكون فارغة ClearAllLists ' تعبئة القوائم للنماذج الخاصة بـ TW عند الضغط على TW Me.lstForms1.AddItem "شاشة الملف التاريخي العام;TW1" Me.lstForms2.AddItem "حركة الملفات التاريخية;TW2" Me.lstForms3.AddItem "الملف التاريخي;TW3" Me.lstForms4.AddItem "حالة المعاملات التاريخية;TW4" Me.lstForms5.AddItem "الشاشة قيد الاجراء;TW5" Me.lstForms6.AddItem "شاشة قيد الاجراء 2;TW6" Me.lstForms7.AddItem "شاشة الملف ;TW7" End Sub Private Sub ClearAllLists() ' إعادة تعيين جميع مربعات القوائم إلى الحالة الافتراضية Me.lstForms1.RowSource = "" Me.lstForms1.Value = Null Me.lstForms2.RowSource = "" Me.lstForms2.Value = Null Me.lstForms3.RowSource = "" Me.lstForms3.Value = Null Me.lstForms4.RowSource = "" Me.lstForms4.Value = Null Me.lstForms5.RowSource = "" Me.lstForms5.Value = Null Me.lstForms6.RowSource = "" Me.lstForms6.Value = Null Me.lstForms7.RowSource = "" Me.lstForms7.Value = Null End Sub Private Sub lstForms1_AfterUpdate() HandleFormOpen Me.lstForms1 End Sub Private Sub lstForms2_AfterUpdate() HandleFormOpen Me.lstForms2 End Sub Private Sub lstForms3_AfterUpdate() HandleFormOpen Me.lstForms3 End Sub Private Sub lstForms4_AfterUpdate() HandleFormOpen Me.lstForms4 End Sub Private Sub lstForms5_AfterUpdate() HandleFormOpen Me.lstForms5 End Sub Private Sub lstForms6_AfterUpdate() HandleFormOpen Me.lstForms6 End Sub Private Sub lstForms7_AfterUpdate() HandleFormOpen Me.lstForms7 End Sub Private Sub HandleFormOpen(lst As Control) ' تحقق من العنصر المحدد في مربع القائمة Dim selectedIndex As Integer selectedIndex = lst.ListIndex If selectedIndex = -1 Then MsgBox "يرجى اختيار عنصر من القائمة.", vbExclamation Exit Sub End If ' تحديد المفتاح الخاص بكل مجموعة من النماذج Dim prefix As String If Me.KH.Visible Then prefix = "FO" ' النموذج المختار من KH ElseIf Me.TW.Visible Then prefix = "TW" ' النموذج المختار من TW End If ' فتح النموذج بناءً على الفئة المختارة Select Case selectedIndex Case 0 OpenFormWithPrefix prefix & "1" Case 1 OpenFormWithPrefix prefix & "2" Case 2 OpenFormWithPrefix prefix & "3" Case 3 OpenFormWithPrefix prefix & "4" Case 4 OpenFormWithPrefix prefix & "5" Case Else MsgBox "النموذج غير موجود." End Select End Sub Private Sub OpenFormWithPrefix(formName As String) If Not IsFormOpen(formName) Then DoCmd.OpenForm formName End If End Sub Private Function IsFormOpen(formName As String) As Boolean ' التحقق إذا كان النموذج مفتوح بالفعل On Error Resume Next IsFormOpen = (CurrentProject.AllForms(formName).IsLoaded) On Error GoTo 0 End Function Private Sub Form_Load() ' إعادة تعيين مربعي القوائم عند فتح النموذج Me.lstForms1.RowSource = "" ' تفريغ مربع القائمة الأول Me.lstForms2.RowSource = "" Me.lstForms3.RowSource = "" Me.lstForms4.RowSource = "" Me.lstForms5.RowSource = "" Me.lstForms6.RowSource = "" Me.lstForms7.RowSource = "" End Sub ما تم هو إضافة منطق لفتح النماذج بناءً على الاختيارات المختلفة ، بالإضافة إلى تخصيص الفتح حسب المجموعة المختارة .

كان الأجدر بك أن تكون واضحاً في طلبك ، وأن يكون ملماً بكل الإحتمالات ، فلست انا من سيقرر الاحتمالات البديلة لكل حقل أكثر من 125 !!!!! شكراً لك

لو تعرف احكيلي علشان نلاقي حد يساعدنا

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

1️⃣ فيما يخص التبويب Print Options :- الأجزاء المظللة باللون الأصفر ( Top , Bottom , Left , Right ) : وظيفتها التحكم بهوامش الصفحة المراد طباعتها . الأجزاء المظللة باللون الأزرق ( Print Data Only ) : يتم طباعة البيانات فقط دون تنسيقات أو إضافات ( مثل الخطوط ، العناوين ، أو النصوص الثابتة ) . الأجزاء المظللة باللون الأخضر ( Print Form Only ، Print Datasheet Only ) : * Print Form Only : لطباعة جزء النموذج فقط . * Print Datasheet Only : لطباعة جزء الجدول أو ورقة البيانات فقط . باختصار هذا الخيار مخصص للنماذج المنقسمة (Split Form) ، حيث يمكن طباعة عرض واحد فقط من النموذج 2️⃣ أما التبويب Columns :- الأجزاء المظللة باللون الأخضر Grid Settings تتيح لك التحكم بعدد الأعمدة المطبوعة في الورقة . على سبيل المثال كما في ( الكتيبات أو التقارير المصفوفة ) ◀ Number of Columns ( عدد الأعمدة ) :- يحدد عدد الأعمدة التي يتم تقسيم الصفحة إليها عند الطباعة . القيمة الافتراضية هي 1 ، ويمكنك زيادتها لطباعة البيانات في عدة أعمدة ( مثل طباعة قائمة عناوين ) . ◀ Row Spacing ( تباعد الصفوف ) :- يحدد المسافة بين كل صف والصف الذي يليه داخل العمود نفسه . يتم قياسه بوحدات القياس المستخدمة ( عادة بالبوصة أو السنتيمتر ) . ◀ Column Spacing ( تباعد الأعمدة ) :- يحدد المسافة بين الأعمدة . يستخدم عند تعيين أكثر من عمود لضمان وجود فراغات مناسبة بينها . الأجزاء المظللة باللون البنفسجي Column Size : ◀ Width ( العرض ) :- يحدد عرض كل عمود . وهو ما قد يؤثر على حجم البيانات المعروضة في العمود . ◀ Height ( الإرتفاع ) :- يحدد ارتفاع العمود . يستخدم لتحديد مساحة القيمة المعروضة داخل العمود. ◀ Same as Detail ( مطابق للتفاصيل ) :- عند تفعيل هذا الخيار ، يتم ضبط أبعاد الأعمدة ( العرض و الارتفاع ) بحيث تكون متطابقة مع تفاصيل التقرير (التخطيط التفصيلي).الأجزاء في اللون البنفسجي ، تسمح لك بالتحكم بعرض وارتفاع المود الواحد في الورقة أو التقرير . وهنا ليس هناك اي قيم محددة بل هي حسب حاجتك . الأجزاء المظللة باللون البرتقالي Column Layout : ◀ Down , then Across ( الإتجاه من الأعلى للأسفل ، ثم عبر الأعمدة ) : حيث يتم ملء البيانات من الأعلى إلى الأسفل في العمود الأول ، ثم ينتقل إلى العمود التالي . ◀ Across , then Down (عبر الأعمدة أولاً ، ثم الإتجاه من الأعلى للأسفل ) : حيث يتم ملء البيانات في الصف الأول من كل الأعمدة ، ثم ينتقل إلى الصف التالي . يعني باختصار شديد هذا التبويب مفيد عند إنشاء تقارير تحتاج إلى تنسيق متعدد الأعمدة ، مثل طباعة بطاقات الأسماء أو قوائم ... إلخ أما فيما يخص مشكلتك مع الأرقام ، فهي باعتقادي تختلف ولن يستطيع أحد معرفة مقاسات وطبيعة تصميم تقاريرك غيرك ؛ فبعد تجربتك المتكررة من التعديل على هذه الارقام ( حسب حاجتك طبعاً ) ستتوصل الى ارقام صحيحة تناسب تصميم تقريرك أو ما تريد طباعته .

هل جربت الكود يا صديقي أولا ... الذي تم هو فقط تعريف المتغير db كما يلي Dim db As DAO.Database Set db = CurrentDb() لم اقم بتجربته ، ولكن هذا ما توضح لي ، وانت صاحب التجربة للعودة لنا بالنتيجة .

انشئ استعلام جديد ، والصق هذا الاستعلام SQL وجرب النتيجة SELECT [Tbl_Tests 2025].Tcode, [Tbl_Tests 2025].Tname, [Tbl_Tests 2025].Out_Lab, IIf([Out_Lab]<50,75,IIf([Out_Lab] Between 51 And 100,100,IIf([Out_Lab] Between 101 And 150,125,Null))) AS NewField FROM [Tbl_Tests 2025];

هل تقصد في حقل مستقل ؟؟؟؟ وضح هذه النقطة اذا سمحت

باعتقادي انك لم تقم بتعريف قاعدة البيانات db .. Public Function relinksqltables() As Boolean On Error GoTo relinksqltablesErr Dim db As DAO.Database Dim tdef As TableDef Dim constr As String Dim cnn As ADODB.Connection Dim strserver As String, strdb As String, struser As String, strpass As String Set db = CurrentDb() constr = "drive={ODBC;DRIVER=ODBC Driver 17 for SQL Server;SERVER=WIN-9V6JHD626P3\SQLEXPRESS;id = administrator;PASSWOR= ;database=tarikbase;Trusted_Connection=yes;APP=SSMA;DATABASE=tarikbase;" DoCmd.SetWarnings False For Each tdef In db.TableDefs Debug.Print tdef.Name If InStr(tdef.Connect, "odbc") And Left(tdef.Name, 3) = "dbo" Then If tdef.Connect <> conster Then tdef.Connect = constr tdef.RefreshLink End If End If Next DoCmd.SetWarnings True Exit Function relinksqltablesErr: relinksqltables = False MsgBox "Error in relinksqltables: " & Err.Description End Function انظر لهذا السطر For Each tdef In db.TableDefs هنا قام الكود باستدعاء db ولكنك لم تقم بتعريفها في الكود الخاص بك

أخي الكريم اهلاً وسهلاً بك معنا .. من وجهة نظري اعتقد أن اعدادات الطباعة قد تختلف بحسب التقرير الذي تريد طباعته ، فعادةً اكسيس يقوم بانشاء تقرير مع افتراض حجم الورق = Letter كما في الصورة أدناه ، في النقطة 2 . وحتى أنه يفترض اتجاه الورقة = بشكل طولي كما في النقطة 1 . أيضاً يقوم باختيار الطابعة الإفتراضية بشكل تلقائي للتقارير كما في النقطة 3 ,, وعليه فإنه وحسب حاجتك في تقريرك ( اختيار اتجاه الورقة = " طولي " أو " عرضي " ) وحجم الورقة = A4 أو A3 ... إلخ . وتحديد الطابعة لكل تقرير . فمثلاً لو كان التقرير هذا يطبع ملصق باركود مثلاً ويوجد طابعة لهذا النوع من الملصقات فيتم اختيارها لهذا التقرير . وإذا كنت في تقرير آخر تريد طباعة معلومات بحجم الورقة العادية = A4 فتختار نوع الطابعة لهذا التقرير بشكل منفصل . وطبعاً هنا في هذه النقطة سيكون الأمر أكثر توسعاً من مجرد اختيار طابعة لكل تقرير دون تحديد اسمها في كود الطباعة ( إن لم تخني معلومتي ) هذا بالنسبة لما تفضلت به في استفسارك .. والله اعلم هي فقط وجهة نظر

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

أهلاً وسهلاً بشيخنا الجليل و والدنا الحبيب .. لدي في أحد مشاريعي فكرة تشابه ما تطلبه ، سأقوم بفصلها عن المشروع وأزودك بفكرتي وطريقتي التي استخدمتها لأحد مراكز اللياقة البدنية مؤخراً ..

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

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

هنا كانت مشكلتك تأكد من أن حالة الحقل Status هي No . هذا ملفك بعد التطبيق مشتريات ومبيعات.accdb

تم انشاء موضوع جديد ، تجده هنا

السلام عليكم ورحمة الله وبركاته ، أخواني وأساتذتي ومعلمينا ( دون استثناء ) قمت بتنفيذ فكرة تشفير السجلات في الجداول ، والذي تهدف إلى حماية البيانات من المتطفلين عند محاولتهم استيراد بيانات الجداول . والفكرة تم تطبيقها وإكمالها خلال طرح مشاركة معلمي الفاضل @ابوخليل في رده على أخونا @الحلبي في مشاركة في موضوع سابق . ولكني هنا اعتمدت على الجدول ( EncryptionStatus ) يحتوي حقل واحد ( Status ) من نوع Yes / No لمعرفة حالة التشفير عند تشغيل التطبيق .. ⭐ البرنامج يهدف إلى تنفيذ عملية تشفير و فك تشفير على كافة جداول قاعدة البيانات باستخدام خوارزمية XOR . وتحتوي الأداة على عدة دوال و وظائف تم تقسيمها وتوزيعها بشكل منفصل لتسهيل فهم وصيانة وتعديل الكود حسب الرغبة والحاجة . وبشكل مختصر سأذكر بعض وظائف هذه الدوال تالياً ، ثم ننتقل الى الكود لاحقاً :- الدالة EncryptDecrypt :- هذه الدالة الرئيسية التي تعمل على تشفير أو الغاء التشفير ؛ حيث تستخدم مفتاح التشفير ( المحدد في strKey ) لتطبيق عملية XOR بين البيانات والنص المشفر . الدالة GetAllTables :- هذه الدالة تقوم بإرجاع قائمة بأسماء كل الجداول في قاعدة البيانات الحالية ( طبعاً باستثناء جداول النظام ) . الدالة CheckEncryptionStatus :- هذه الدالة تتحقق من حالة التشفير ، عن طريق التحقق من قيمة الحقل Status في جدول EncryptionStatus . بحيث إذا كانت قيمة الحقل = True ، فإن قاعدة البيانات تكون مشفرة . الدالة EncryptAllTablesIndependently : - تم إضافتها لاستدعائها عند الخلل ( إجراء إحترازي ) .... والعديد من الدوال . كود المديول :- Option Compare Database Public Const EnCodeKey As String = "Officna2024" Public Function EncryptDecrypt(strData As String, strKey As String) As String Dim i As Integer Dim strResult As String Dim keyLen As Integer Dim keyValue As Integer strResult = "" If Len(strKey) = 0 Then MsgBox "مفتاح التشفير غير صحيح", vbCritical, "" Exit Function End If keyLen = Len(strKey) For i = 1 To Len(strData) keyValue = Asc(Mid(strKey, ((i - 1) Mod keyLen) + 1)) strResult = strResult & Chr(Asc(Mid(strData, i, 1)) Xor keyValue) Next i EncryptDecrypt = strResult End Function Public Function GetAllTables() As Collection Dim db As DAO.Database Dim tblDef As DAO.TableDef Dim tblNames As New Collection Set db = CurrentDb For Each tblDef In db.TableDefs If Left(tblDef.Name, 4) <> "MSys" Then tblNames.Add tblDef.Name End If Next tblDef Set GetAllTables = tblNames End Function Public Function CheckEncryptionStatus() As Boolean On Error GoTo ErrorHandler Dim db As DAO.Database Dim rs As DAO.Recordset Dim status As Boolean Set db = CurrentDb Set rs = db.OpenRecordset("EncryptionStatus", dbOpenDynaset) If Not (rs.EOF And rs.BOF) Then rs.MoveFirst status = rs!status Else status = False End If rs.Close Set rs = Nothing Set db = Nothing CheckEncryptionStatus = status Exit Function ErrorHandler: MsgBox "لا يمكنك استخدام هذا المشروع في الوقت الحالي", vbCritical, "" EncryptAllTablesIndependently EnCodeKey DoCmd.Quit Exit Function End Function Public Sub EncryptAllTablesIndependently(ByVal strKey As String) Dim db As DAO.Database Dim tblName As Variant Dim rs As DAO.Recordset Dim fld As DAO.Field Dim tblList As Collection If Len(strKey) = 0 Then MsgBox "مفتاح التشفير غير صحيح", vbCritical, "" Exit Sub End If Set db = CurrentDb Set tblList = GetAllTables() For Each tblName In tblList Set rs = db.OpenRecordset(tblName, dbOpenDynaset) If Not (rs.EOF And rs.BOF) Then rs.MoveFirst Do Until rs.EOF For Each fld In rs.Fields If fld.Type = dbText Then rs.Edit rs(fld.Name).Value = EncryptDecrypt(Nz(rs(fld.Name), ""), strKey) rs.Update End If Next fld rs.MoveNext Loop End If rs.Close Next tblName End Sub Public Sub SetEncryptionStatus(status As Boolean) Dim db As DAO.Database Dim rs As DAO.Recordset Set db = CurrentDb Set rs = db.OpenRecordset("EncryptionStatus", dbOpenDynaset) If Not (rs.EOF And rs.BOF) Then rs.MoveFirst rs.Edit rs!status = status rs.Update Else rs.AddNew rs!status = status rs.Update End If rs.Close End Sub Public Sub EncryptOrDecryptTables(ByVal strKey As String, ByVal isEncrypting As Boolean) Dim db As DAO.Database Dim tblName As Variant Dim rs As DAO.Recordset Dim fld As DAO.Field Dim tblList As Collection Dim action As String Set db = CurrentDb Set tblList = GetAllTables() action = IIf(isEncrypting, "تشفير", "فك التشفير") For Each tblName In tblList Set rs = db.OpenRecordset(tblName, dbOpenDynaset) If Not (rs.EOF And rs.BOF) Then rs.MoveFirst Do Until rs.EOF For Each fld In rs.Fields If fld.Type = dbText Then rs.Edit rs(fld.Name).Value = EncryptDecrypt(Nz(rs(fld.Name), ""), strKey) rs.Update End If Next fld rs.MoveNext Loop End If rs.Close Next tblName MsgBox "تمت عملية " & action & " بنجاح", vbInformation, "" End Sub Public Sub HandleEncryptionOnFormOpen() If CheckEncryptionStatus() = True Then Call EncryptOrDecryptTables(EnCodeKey, False) SetEncryptionStatus False End If End Sub Public Sub HandleEncryptionOnFormClose() If CheckEncryptionStatus() = False Then Call EncryptOrDecryptTables(EnCodeKey, True) SetEncryptionStatus True End If End Sub Public Function GetTotalRecordCount() As Long Dim db As DAO.Database Dim tblDef As DAO.TableDef Dim totalCount As Long Dim rs As DAO.Recordset Set db = CurrentDb totalCount = 0 For Each tblDef In db.TableDefs If Left(tblDef.Name, 4) <> "MSys" Then Set rs = db.OpenRecordset(tblDef.Name, dbOpenSnapshot) If Not (rs.EOF And rs.BOF) Then rs.MoveLast totalCount = totalCount + rs.recordCount End If rs.Close End If Next tblDef Set db = Nothing GetTotalRecordCount = totalCount End Function تم تنفيذ الفكرة بطريقتين ، الأولى من خلال الإعتماد على النموذج الرئيسي الذي يفتح به المشروع ( في حدث عند التحميل يتم الغاء التشفير ) وعند زر إغلاق المشروع يوجد حدث لإعادة التشفير لجميع الجداول مرة واحدة وبسرعة مهما كان عدد السجلات . والثانية من خلال نموذج آخر عند النقر على زر Start يبدأ شريط التحميل والذي يعتمد على عدد السجلات في جميع الجداول التي تم تشفيرها بالتقدم من 0 - 100% . وعند اغلاق النموذج يتم اعادة التشفير مرة أخرى . ✔ خطوات الحصول على النتيجة الصحيحة كالآتي :- ✔ انسخ الجدول (EncryptionStatus ) والمديول ( Encryption ) إلى أي مشروع تريده . ✔ تأكد من أن جميع السجلات غير مشفرة . ✔ تأكد من أن حالة الحقل Status هي No . قمت بكتابة الموضوع على عجالة ، وتركت الباب مفتوح للنقاش . Tashfeer 2024.accdb

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