ابو جودي

ابدأ فى العمل وعندما تتعثر اسأل مبدأ المنتدى سؤال وجواب يا صديقى العزيز هذا القسم من المنتدى تعليمى أما ولكن فى حالة طلب ليس هذا المكان المناسب وإنما عليك أن >>---> تتوجه الى هنا على الفور

اتفضلى يا ست الدكتورة على الله بس الشغل يعجب معاليكى كده 3 جنيه مش حسيبهم يرجى التركيز جيدا لقد قمت تقريبا بتكويد العمل كله من خلال وحدة نمطية ولا يوجد اى اكواد مستقبلا تخص هذه الجزئية فى النماذج يتم استدعاء الدوال لحدث التركيز من خلال Expression Builder وليس من خلال Code Builder وبالتالى حدث التركيز يتم استدعاءه بالشكل التالى = TextBox_GotFocus([Form],[TestnameN]) مما تتيح هذه الطريقة اختيار كل مربعات النص دفعة واحدة التى نريد تفيذ هذا الاجراء عليها ووضع كود الاستدعاء السابق فى حدث التركيز مرة واحدة بدلا من عمل ذلك لكل مربع والمعلمات التى نمررها لكود الاستدعاء هذا تكون كالتالى اسم النموذج الحالى وبدلا من كتابة اسم النموذج كل مرة فقط [Form] سوف تتكفل بذلك. اما الجزء الثانى اسم مربع النص الذى نريد تحديث قيمته الكود الثانى فى حدث النقر المزدوج بنفس الآلية والاسلوب السابق ولكن يزيد عليه اضافة القيمة البولينية (Boolean value) >>--> True بالشكل التالى : =OpenListBoxForm([Form],[TestnameN],True) عندما يكون الاستدعاء بالشكل السابق سوف يتم استدعاء النموذج Resultaddfixed_frm بقائمة قيم متعددة .. لا سحر ولا شعودة دا اكسس يا حضرات طيب وعندما نريد للقيم ان تكون مفردة وليست متعددة يتم الاستدعاء بالشكل الافتراضى بدون اضافة القيمة البولينية (Boolean value) =OpenListBoxForm([Form],[TestnameN]) وفى انتظار رأى استاذى الجليل ومعلمى القدير الاستاذ @Moosak صاحب المكتبة العامرة هل تستاهل الافكار هنا فى المرفقات الثالث والرابع عبى يابا واللا ايه وطبعا فى إنتظار رأى استاذى الجليل ومعلمى القدير الاستاذ @kkhalifa1960 والذى اسأل الله تعالى له الشفاء و دوام الصحة والعافية والبركة فى العمر والعمل بما أنه صاجب السبق فى الرد على الموضوع احد اعمدة المنتدى الذين اتعلم منهم الطريقة الرابعة.accdb

يعنى لو حققت لك ده نشتغل بالطريقة الاولى واللا الثالثة ؟

لو الطريقة الثالثة مع بيانات كثيرة سريعة وفعالة بس الاول فول لى مربع النص اللى انا مسحته بتستخدميه فى ايه وانا اوجد لك الحل وبعدين ولو حتستخدمى الطريقة الاول ودى اخر كلام هاروح احمل مرفقها واشوف هاعملها لك ازاى منتظر رايك وبسرعة

طيب قبل ما افكر فى تحقيق المطلب بتاع اختيار قيمة او اكثر عاوزه التعديل على انهو طريقة من الثلاثة ؟

طب وعلشان يبقى لى جنية مش ربع جنيه بس 😡 الطريقة الثالثة والاخير كما ينبغى انا عن نفسى لو دا شغلى حيبقى كده الفيم الافتراضية اللى عمالين نعملها DLookUp كل شوية لكل حقل اللى بصراحة انا مش عارف معناها ايه ولكن ايه العذاب ده هى حبة سطور فى موديول وخلصت الحكاية ' Procedure to load default values from lookup table into text boxes for any form Public Sub LoadDefaultValues(frm As Form) Dim ctl As Control Dim defaultValue As String For Each ctl In frm.Controls ' Check if the control is a text box and has the specific tag If ctl.ControlType = acTextBox And ctl.Tag = "GetTestFixedData" Then ' Set the default value if it exists defaultValue = Nz(DLookup("fixeddefault", "fixed_tbl", "[Reportname] = '" & ctl.Name & "'"), "") If defaultValue <> "" Then ctl.defaultValue = """" & defaultValue & """" Else ctl.defaultValue = "" End If End If Next ctl ' Repaint and process events for the entire form Call RepaintAndProcessEvents(frm) End Sub اعملى بقه 100 تموذج وفى كل نموذج حطى الـ 80 مربع نص باسمائهم صح وبس فى حدث التحميل Call LoadDefaultValues(Me) وهو شاطر وابن حلال هيفهمك لوحده وبسرعة ويحقق لك احلامك بس بشرط هنجيلة كمان شوية --- طيب طالما ان النماذج ممكن تكون كثيرة وكذلك مربعات النص لنتائح التحاليل انا وفرت كل شوية كتابة كود فى حدث التركيز لكل مربع نص لانه عذاب ووجع قلب اه والله زيمبئولك كده بجد الا اذا وقتك فاضى بئه وعاوزة تضيعيه ومعاه عمرك فى كتر الكتابة كل الحكاية انا فى الدالة دة OpenListBoxForm استخدمت السطر ده defaultValue = Nz(DLookup("fixedname", "fixed_tbl", "[Reportname] = '" & FormName.ActiveControl.Name & "'"), "") ده بيعمل ايه والمفروض انا التزم بأيه علشان يشتغل معايا صح ده بيروح قبل ما يفتح نموذج الليست بوكس ع الجدول fixed_tbl وتبعا لاسم مربع النص اللى انا هاعمل عليع دوبل كليك يجيبلك قيمة fixedname لما يكون الحقل Reportname = اسم مربع النص الحالى ولو تفتكرى قلتلك " بس بشرط هنجيلة كمان شوية " وهنا نيجى للنقطة المهمة جدا جدا جدا دى القيمة اللى فى الجدول fixed_tbl فى حقل fixeddefault واللى هتكون بداخل مربع النص اللى انا هأفتح منه الليست بوكس لازم يكون اسم مربع النص بنفس اسم القيمة اللى فى Reportname فى نفس الجدول ده " وهو ده الشرط المهم " طبعا الشغل اللى فات ده كله بناء على تحليل الالية والنتائج والافكار اللى انا شوفتها فى تصميمك المرفق اذا انا فهمت وحللت صح او طبعا سيادتك ما تفاجئينا كالعادة طبعا بعد تقديم الحل انك تقصدى شئ تانى او فى شئ خفى فى تصميمك ولم تذكيرة او لم تطلبى كل طلباتك والمتعلقة بالسؤال والموضوع مرة واحدة المرفق بعد كل التعديلات ومسح كل الزيادات ووجع القلب اللى كان وتضيع الوقت والعمر فى تكرار اكواد كثيرة تم اعادة تنقيحه وهيكلتة اذا وافق رغباتك يبفى الحمد الله فضل ونعمه 🤲👌 اذا فى مفاجئات كالعادة يبقى لنا الله الطريقة الثالثة.accdb

ملاحظة هامة جدا انا مازلت على سفر يعنى ارجو التماس العزر لى فى حالة التاخير انا فى العمل وقتى ضيق

وادى الطريقة التانية وشوفى كم الاكواد اللى هتبطلى تكبتبيها عمال على بطال فى النماذج كده الحساب ربع جنية بس يلا خليها علينا احنا الطريقة الثانية.accdb

ان شاء الله نعم انا مجيب اعتذر على التأخير انا على سفر هناك طريقة ثانية لاختصار واختزال كل اوامر الـتركيز >>--->> GotFocus() بس لما حضرتك تاكدى على الاول ان هى دى النتيحة اللى انتى عاوزاها صح يا افندم الطريقة الاولى.accdb

يمكنك إنشاء الجدول tblRecords قم بعمل الحقول NationalID النوع: Text (نص) الطول: 14 (أو حسب طول الرقم القومي الخاص بك) RecordYear النوع: Number (رقم) الحجم: Integer (عدد صحيح) قم بتحديد NationalID , RecordYear كحقول مفتاح مركب (Composite Key) لضمان عدم تكرار الرقم القومي لنفس السنة لعمل المفتاح المركب: بعد إضافة الحقول اضغط على Ctrl من لوحة المقاتيج واستمر بالضغط عليها أثناء تحديد الحقول NationalID , RecordYear انقر بزر الماوس الأيمن على أي من الحقول المحددة واختر "Primary Key" (مفتاح أساسي) من القائمة المنسدلة بذلك سوف يظهر رمز المفتاح بجانب الحقول المختارة الان قم باعداد نموذج لإدخال البيانات في الجدول tblRecords تأكد من تأكد من أن لديك مربعات نصية باسماء txtNationalID , txtRecordYear في نموذج إدخال البيانات الان على زر الامر حفظ اضف الكود الاتى : Dim db As DAO.Database Dim rst As DAO.Recordset Dim strSQL As String Dim NationalID As String Dim RecordYear As Integer NationalID = Me.txtNationalID.Value RecordYear = Me.txtRecordYear.Value strSQL = "SELECT * FROM tblRecords WHERE NationalID = '" & NationalID & "' AND RecordYear = " & RecordYear Set db = CurrentDb Set rst = db.OpenRecordset(strSQL) If rst.EOF Then DoCmd.RunCommand acCmdSaveRecord MsgBox "Record saved successfully!", vbInformation Else MsgBox "This National ID is already present for the year " & RecordYear & ".", vbExclamation End If rst.Close Set rst = Nothing Set db = Nothing

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

السلام عليكم ورحمة الله تعالى وبركاته استاذى الجليل ومعلمى القدير الاستاذ @kkhalifa1960 اسعد الله صباحكم طيب ايه رايك اقول لحضرتك على فكرة بنت حلال وبسيطة قوى قوى وقمة فى السهولة نمسح كل كل الاكواد وكل الوحدات النمطية من المرفق وننشئ وحدة نمطية جديدة مثلا باسم : basFillFields ونضع بها الدوال الاتية Option Compare Database Option Explicit Const ListBoxFormName As String = "frm_Specifications" Public Function OpenListBoxForm(FormName As Form) DoCmd.OpenForm ListBoxFormName, , , , , acDialog, FormName.Name & ";" & FormName.ActiveControl.Name End Function Public Function UpdateFieldFromListBox(FormName As String, FieldName As String, SelectedValue As Variant) Forms(FormName).Controls(FieldName).Value = SelectedValue End Function بس كده وفى كل النماذج فقط يكون الكود Option Compare Database Option Explicit Private Sub CmdClose_Click() DoCmd.Close End Sub اما بالنسبة لنموذج :frm_Specifications سوف نستخدم الاكواد الاتية Option Compare Database Option Explicit Dim Args() As String Private Sub List0_DblClick(Cancel As Integer) Args = Split(Me.OpenArgs, ";") Call UpdateFieldFromListBox(Args(0), Args(1), Me.List0.Value) DoCmd.Close acForm, Me.Name End Sub Private Sub List0_Click() Args = Split(Me.OpenArgs, ";") frm1 = Args(0) Txt2 = Args(1) Me.Txt1 = Me.List0.Column(0) End Sub Private Sub cmdOK_Click() Call UpdateFieldFromListBox(Args(0), Args(1), Me.List0.Value) DoCmd.Close acForm, Me.Name End Sub وطبعا انا استخدمت الاكواد السابقة للحفاظ على التصميم والية العمل وفقا للمرفق تماما ولكن يمكن فقط استخدام هذا الجزء فقط والاستغناء عن باقى الاكواد الاخرى Option Compare Database Option Explicit Dim Args() As String Private Sub List0_DblClick(Cancel As Integer) Args = Split(Me.OpenArgs, ";") Call UpdateFieldFromListBox(Args(0), Args(1), Me.List0.Value) DoCmd.Close acForm, Me.Name End Sub طيب الان نصل الى اهم واجمل جزء الاستدعاء سوف اقوم باستخدام Expression Builder لاستدعاء الدالة بالشكل التالى =OpenListBoxForm([Form]) واخيرا المرفق DDTest602-3.accdb

اتفضل Dim Omra As Boolean Dim OmraAnne As Integer Omra = IIf(DLookup("Haj", "Mena7", "EmployeeID =" & Me.EmployeeID & " AND Menha_ID = 11") = -1, True, False) OmraAnne = DLookup("annee", "Mena7", "EmployeeID =" & Me.EmployeeID & " AND Menha_ID = 11") If Omra = True Then MsgBox "هذا الموظف مستفيد من منحة العمرة خلال سنة " & OmraAnne Me.Undo Exit Sub End If

ومشاركة واثراء للموضوع ازيدكم من الشعر بيتا لماذا دائما نتجاهل استخدام دالة Switch و اول ما يشغل بالنا هو دائما دالة iif استخدام Switch انا احبه وافضله عن استخدام دالة iif يعدا قل تعقيدا واكثر سهولة فى الفهم ممكن استخدام الكود االتالى ' Sets rb to "normal" if Hb is between 10 and 16 (inclusive). ' Sets rb to "up" if Hb is greater than 16. ' Sets rb to "down" if Hb is less than 10. ' Sets rb to "" if Hb is blank. Me.rb = Switch( _ [Hb] >= 10 And [Hb] <= 16, "normal", _ [Hb] > 16, "up", _ [Hb] < 10, "down", _ [Hb] = "", "" _ ) طبعا انا قمت بكتابته على هذا النحو للتوضيح ممكن كتابته بالشكل التالى Me.rb = Switch([Hb] >= 10 And [Hb] <= 16, "normal", [Hb] > 16, "up", [Hb] < 10, "down", [Hb] = "", "")

حزاكم الله خيرا استاذى الجليل و معلمى القدير و والدى الحبيب استاذ @ابوخليل ابشركم بالخير ان شاء الله جارى العمل لاننى ايضا للاسف لم احتفظ او فقدت القاعدة السابقة سوف اشارككم القواعد بمجرد الانتهاء منها

جربى الكود دع يا دكتور Private Sub btnAdd_Click() On Error GoTo ErrorHandler Dim db As DAO.Database Dim rs As DAO.Recordset Dim fixedNameValue As String Dim newResultValue As String Dim fixedDefaultValue As Variant Dim fixedNormalValue As Variant Dim reportNameValue As Variant Dim sql As String Dim MAXCODE As Long ' الحصول على القيم من الحقول fixedNameValue = Me.testnameN newResultValue = Me.Newresult fixedDefaultValue = Me.fixeddefault fixedNormalValue = Me.fixednormal reportNameValue = Me.Reportname ' التحقق من أن القيم ليست فارغة If IsNull(fixedDefaultValue) Or IsNull(fixedNormalValue) Or IsNull(reportNameValue) Then MsgBox "يرجى استكمال باقي البيانات (fixeddefault, fixednormal, Reportname) قبل الإضافة.", vbExclamation Exit Sub End If If IsNull(fixedNameValue) Or IsNull(newResultValue) Then MsgBox "يجب إدخال القيم المراد إضافتها ثم الضغط على زر الإضافة.", vbExclamation Exit Sub End If ' فتح قاعدة البيانات Set db = CurrentDb ' التحقق مما إذا كانت القيم موجودة بالفعل sql = "SELECT COUNT(*) AS RecordCount FROM fixedresults_tbl WHERE Fixedname = '" & fixedNameValue & "' AND Fixedresult = '" & newResultValue & "'" Set rs = db.OpenRecordset(sql) If Not rs.EOF And rs!RecordCount > 0 Then MsgBox "القيمة المدخلة موجودة مسبقًا.", vbExclamation rs.Close Set rs = Nothing Set db = Nothing Exit Sub End If rs.Close Set rs = Nothing ' تحديد الرقم الجديد MAXCODE = Nz(DMax("code", "fixedresults_tbl"), 0) Me.code.Value = MAXCODE + 1 ' إضافة السجل الجديد إلى fixedresults_tbl sql = "INSERT INTO fixedresults_tbl (code, Fixedname, Fixedresult) " & _ "VALUES (" & Me.code.Value & ", '" & fixedNameValue & "', '" & newResultValue & "')" db.Execute sql, dbFailOnError ' إعادة تحميل القائمة وتفريغ الحقول Resultlist.Requery Me.Newresult.Value = "" MsgBox "تمت الإضافة بنجاح!", vbInformation ' فتح الجدول المراد التحديث له Set rs = db.OpenRecordset("Fixed_tbl", dbOpenDynaset) ' التحقق مما إذا كان السجل موجود بالفعل لمنع التكرار rs.FindFirst "fixedname = '" & fixedNameValue & "'" If rs.NoMatch Then ' إضافة سجل جديد rs.AddNew rs!fixedname = fixedNameValue rs!fixeddefault = fixedDefaultValue rs!fixednormal = fixedNormalValue rs!Reportname = reportNameValue rs.Update Else ' تحديث السجل الموجود rs.Edit rs!fixeddefault = fixedDefaultValue rs!fixednormal = fixedNormalValue rs!Reportname = reportNameValue rs.Update End If ' إغلاق مجموعة السجلات rs.Close Set rs = Nothing Set db = Nothing MsgBox "تمت الإضافة بنجاح!", vbInformation Exit Sub ErrorHandler: MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical If Not rs Is Nothing Then rs.Close Set rs = Nothing End If If Not db Is Nothing Then Set db = Nothing End If End Sub

هو المفروض ايه اللى يحصل طيب معلش لان انا مش متابع من الاول علشان ننجز بدل ما الف كتير على ما افهم قولى لى السيناريو المطلوب تحقيقة نظريا بعيد عن الاكواد بس علشان اقدر افهم الاول وانا لو تفتكرى يا دكتور فى البداية نصحتك وما اتنصحتيش قلت لك اختارى اسماء الحقول تدل على وظيفتها هى والمتغيرات علشان تحليل الكود يكون سلسل منا قلت لك يا ست هانم لازم ازعق يعنى 😡 لازم نقضل نلف حوالين نفسينا علشان نفهم ياربى يعنى ياربى الجو حر وكمان سيادة الدكتور تطلع عنينا

طبعا اكيــــد هم فى بيتهم وانا فى بيتى انا لا والله من دماغى انا من كوكب الارض ومن مصر هي فين دى انا مش شايف اى حاجة ! انت بعد كل ده تخون العشرة وتضحك على يا حبيب الملايين نص ساعة بس ؟ سبحان الله فعلا القارئ كالحالب والسامع كالشارب احلب ان فى الكود بالساعات وانت تيجى بسهولة ع الماشى تشربه فى نص ساعه بس بس مش خسارة فيك فأنت ومن أنت أنت صاحب المكتبة العامرة اسأل الله ان يجعل قلبكم عامر بالايمان مثل مكتبتكم العامرة بالتحف ويحك لله درك يا رجل حياكم الله وبياكم ... مهارة ايه الهمام المقدام لا املك منها ذرة هذا فضل الله تعالى ثم اساتذتنا الذين نتعلم منهم وعلى خطاهم نسير فنحن طلاب العلم نطوف في ربوع وبساتين استاذتنا فنقطف من كل بستان زهرة ونرتشف من كل نبع قطره اسأل الله تعالى ان يبارك لنا الله في اساتذتنا العظماء ويأجرهم عنا كل خير وأن يكتب كل خرف يكتبونه في موازين أعمالهم صدفة جارية الى يوم الدين يلا الواجب بتاعك تعمل الحقول السودا وتكمل مشروعك الـ Version 2.16 إن شاء الله ثم تخبرنا عن رابط المشروع النهائى علشان المساكين امثالى يريدون ملئ مكتبتهم الخاوية جزاكم الله خيـــرا على دعواتكم الطيبة احبكم في الله ولوجه الله ♥ 🥰 انا اتحمس عندما انافسك بكل صراحة انت ند قوى ومتعب جدا جدا جدا اتعب عندما اتنافس معك .. ولكن هى والله حب ومودة ولله وفى ذلك فليتنافس المتنافسون وذلك ميدان المتحابين المجانين فلتخلع نعليك ولتشمر عن ساعديك

وطبعا لان المرفقات ممكن يصيبها العطب الشغل كله كله كله تقريبا من خلال الاكواد فى الوحدة النمطية اللى باسم : basCrossword وباقى الاكواد فى النماذح مجرد استدعاء لا اكثر ولا اقل Option Compare Database Option Explicit ' Constants for form and table names Public Const Cnst_FormName_Settings As String = "frmCrosswordSetting" Public Const Cnst_FormName_QuestionsAnswers As String = "frmQuestionsAnswers" Public Const Cnst_FormName_Crossword As String = "frmCrossword" Public Const Cnst_TableName_Settings As String = "tblSetting" Public Const Cnst_TableName_Questions As String = "tblQuestionsAnswers" Public Const Cnst_TableName_GridMap As String = "tblCrosswordGridMap" ' Variables for grid settings Public intRowCellsNumber As Integer Public intTotalCellsNumber As Integer Public strLanguage As String ' Sub to add a new setting Public Sub AddSetting() On Error GoTo AddSetting_Error ' Delete records from related tables before adding new settings DeleteRecordsFromTable Cnst_TableName_GridMap DeleteRecordsFromTable Cnst_TableName_Questions DeleteRecordsFromTable Cnst_TableName_Settings Dim db As DAO.Database Dim rs As DAO.Recordset Set db = CurrentDb Set rs = db.OpenRecordset(Cnst_TableName_Settings, dbOpenDynaset) ' Add a new record to the setting table if it's empty If rs.EOF And rs.BOF Then rs.AddNew rs!CountRowCol = intRowCellsNumber rs!Language = strLanguage rs.Update Else MsgBox "Table is not empty. Add records accordingly." End If rs.Close Set rs = Nothing Set db = Nothing Exit Sub AddSetting_Error: MsgBox "Error adding records: " & Err.Description, vbExclamation End Sub ' Sub to create a new grid Public Sub CreateNewGrid() On Error GoTo CreateNewGrid_Error Dim frm As Form Dim intColumnIndex As Integer Dim intRowIndex As Integer DoCmd.OpenForm Cnst_FormName_Crossword, acDesign Set frm = Forms(Cnst_FormName_Crossword) ' Define positions for controls Dim intPosTop As Integer Dim intPosLeft As Integer intPosTop = 0.1667 * 1440 intPosLeft = 0.0833 * 1440 ' Define sizes for controls Dim intCellWidth As Integer Dim intCellHeight As Integer intCellWidth = 0.3556 * 1440 intCellHeight = 0.3556 * 1440 ' Define left position for labels and text boxes Dim intPosLeftLabel As Integer Dim intPosLeftTxtBox As Integer intPosLeftLabel = intPosLeft + intCellWidth intPosLeftTxtBox = intPosLeft + intCellWidth ' Create column labels For intColumnIndex = 1 To intRowCellsNumber Dim strColLabelName As String strColLabelName = "lblCol" & intColumnIndex Dim intColLabelLeft As Integer intColLabelLeft = intPosLeftLabel + ((intColumnIndex - 1) * intCellWidth) Dim colLabel As control Set colLabel = CreateControl(Cnst_FormName_Crossword, acLabel, acDetail, , , intColLabelLeft, intPosTop, intCellWidth, intCellHeight) colLabel.Name = strColLabelName colLabel.Caption = intColumnIndex colLabel.Tag = "GridControl" colLabel.Visible = True colLabel.TextAlign = 2 ' Center alignment Next intColumnIndex ' Create row labels For intRowIndex = 1 To intRowCellsNumber Dim strRowLabelName As String strRowLabelName = "lblRow" & intRowIndex Dim intRowLabelTop As Integer intRowLabelTop = intPosTop + (intRowIndex * intCellHeight) Dim rowLabel As control Set rowLabel = CreateControl(Cnst_FormName_Crossword, acLabel, acDetail, , , intPosLeft, intRowLabelTop, intCellWidth, intCellHeight) rowLabel.Name = strRowLabelName rowLabel.Caption = intRowIndex rowLabel.Tag = "GridControl" rowLabel.Visible = True rowLabel.TextAlign = 2 ' Center alignment Next intRowIndex ' Create text boxes for grid For intRowIndex = 1 To intRowCellsNumber For intColumnIndex = 1 To intRowCellsNumber Dim strControlName As String strControlName = "txt" & ((intRowIndex - 1) * intRowCellsNumber + intColumnIndex) Dim ctrl As control Set ctrl = CreateControl(Cnst_FormName_Crossword, acTextBox, acDetail, , , intPosLeftTxtBox + ((intColumnIndex - 1) * intCellWidth), intPosTop + (intRowIndex * intCellHeight), intCellWidth, intCellHeight) ctrl.Name = strControlName ctrl.Tag = "GridControl" ctrl.Visible = True ctrl.TextAlign = 2 ' Center alignment Next intColumnIndex Next intRowIndex DoCmd.Close acForm, Cnst_FormName_Crossword, acSaveYes Exit Sub CreateNewGrid_Error: MsgBox "Error creating new grid: " & Err.Description End Sub ' Ensure the form exists, and create it if it doesn't Public Sub EnsureFormExists() On Error Resume Next ' Try to open the form DoCmd.OpenForm Cnst_FormName_Crossword, acNormal If Err.Number <> 0 Then ' If form doesn't exist, create it CreateNewForm End If DoCmd.Close acForm, Cnst_FormName_Crossword End Sub ' Create a new form and save it with the specified name Public Sub CreateNewForm() Dim frmNewForm As Form Set frmNewForm = CreateForm ' Set form properties With frmNewForm .ScrollBars = 0 ' Neither .RecordSelectors = False ' No record selector .NavigationButtons = False ' No Navigation End With Dim strTempFormName As String strTempFormName = frmNewForm.Name ' Save the form DoCmd.Save acForm, strTempFormName DoCmd.Close acForm, strTempFormName ' Rename the form to the main form name DoCmd.Rename Cnst_FormName_Crossword, acForm, strTempFormName ' Open the settings form DoCmd.Close acForm, Cnst_FormName_Settings, acSaveYes DoCmd.OpenForm Cnst_FormName_Settings, acNormal End Sub ' Sub to delete the old grid Public Sub DeleteOldGrid() On Error Resume Next Dim frm As Form Dim ctrl As control Dim colControlsToDelete As New Collection Dim intIndex As Integer DoCmd.OpenForm Cnst_FormName_Crossword, acDesign Set frm = Forms(Cnst_FormName_Crossword) ' Collect controls to delete For Each ctrl In frm.Controls If ctrl.ControlType = acTextBox Or ctrl.ControlType = acLabel Then If ctrl.Tag = "GridControl" Then colControlsToDelete.Add ctrl.Name End If End If Next ctrl ' Delete collected controls For intIndex = colControlsToDelete.Count To 1 Step -1 DeleteControl Cnst_FormName_Crossword, colControlsToDelete(intIndex) Next intIndex '||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| DoCmd.Close ObjectType:=acForm, ObjectName:=Cnst_FormName_Crossword, Save:=acSaveYes Set ctrl = Nothing Set frm = Nothing End Sub ' Generate a grid based on the total number of controls Public Sub GenerateGrid() On Error GoTo GenerateGrid_Error EnsureFormExists If intRowCellsNumber > 0 And intRowCellsNumber <= 144 Then DeleteOldGrid CreateNewGrid AddRecordsToTable intTotalCellsNumber DoCmd.Close acForm, "frmNewSettingGame", acSaveYes Else MsgBox "Please enter an integer between 3 and 12." End If Exit Sub GenerateGrid_Error: CreateNewForm End Sub ' Function to add records to the grid map table Public Function AddRecordsToTable(ByVal intNumberOfRecords As Integer) As Boolean On Error GoTo AddRecords_Error Dim db As DAO.Database Dim rs As DAO.Recordset Dim intIndex As Integer DeleteRecordsFromTable Cnst_TableName_GridMap DeleteRecordsFromTable Cnst_TableName_Questions Set db = CurrentDb Set rs = db.OpenRecordset(Cnst_TableName_GridMap, dbOpenDynaset) If rs.EOF And rs.BOF Then ' If the table is empty, add the required number of records For intIndex = 1 To intNumberOfRecords rs.AddNew rs!characterID = intIndex rs.Update Next intIndex Else ' If the table is not empty, inform the user MsgBox "Table is not empty. Add records accordingly." End If rs.Close Set rs = Nothing Set db = Nothing AddRecordsToTable = True Exit Function AddRecords_Error: DeleteRecordsFromTable Cnst_TableName_GridMap DeleteRecordsFromTable Cnst_TableName_Questions rs.Close Set rs = Nothing Set db = Nothing AddRecordsToTable = False End Function ' Sub to delete all records from a specified table Public Sub DeleteRecordsFromTable(ByVal strTableName As String) On Error GoTo DeleteRecords_Error Dim db As DAO.Database Dim strSQL As String Set db = CurrentDb ' Define SQL statement to delete all records from the specified table strSQL = "DELETE FROM " & strTableName ' Execute SQL statement db.Execute strSQL, dbFailOnError Set db = Nothing Exit Sub DeleteRecords_Error: MsgBox "Error deleting records: " & Err.Description, vbExclamation Set db = Nothing End Sub ' Function to check if a field exists in a recordset Private Function FieldExists(ByVal rs As DAO.Recordset, ByVal strFieldName As String) As Boolean On Error Resume Next FieldExists = (Not IsError(rs.Fields(strFieldName).Value)) End Function ' Function to retrieve settings from Cnst_TableName_Settings table ' Uses DLookup and Split functions to retrieve values for CountRowCol and Language fields ' Returns True if successful, False otherwise Public Function GetSettings() As Boolean Dim settingRow As String Dim settingsArray() As String Dim rowCellsNumber As Integer Dim Language As String ' Retrieve the full row value from the table settingRow = DLookup("CountRowCol & ',' & Language", Cnst_TableName_Settings) ' Use Split function to separate the retrieved values settingsArray = Split(settingRow, ",") ' Retrieve CountRowCol value from the table If UBound(settingsArray) >= 0 Then intRowCellsNumber = Val(settingsArray(0)) ' Convert value to integer End If ' Retrieve Language value from the table If UBound(settingsArray) >= 1 Then strLanguage = settingsArray(1) End If ' ' You can use the retrieved values as needed here ' Debug.Print "Row/Column Count: " & intRowCellsNumber ' Debug.Print "Language: " & strLanguage ' Set the function return value to True to indicate success GetSettings = True End Function ' Set frm = Forms!frmMain!frmCrossword.Form Public Function UpdateGridWithWords() On Error GoTo UpdateGridWithWords_Error Dim db As DAO.Database Dim rs As DAO.Recordset Dim RSCrossword As DAO.Recordset Dim QuestionValue As String Dim AnswerValue As String Dim StartRow As Integer Dim StartCol As Integer Dim Direction As String Dim i As Integer Dim intQuestionID As Integer Dim frm As Form Set db = CurrentDb() Set rs = db.OpenRecordset(Cnst_TableName_Questions, dbOpenDynaset) Set RSCrossword = db.OpenRecordset(Cnst_TableName_GridMap, dbOpenDynaset) ' Set frm = Forms(strformGrid).Form ' Get the reference to the open form Set frm = Forms(Cnst_FormName_Settings)(Cnst_FormName_Crossword).Form If Not (rs.EOF And rs.BOF) Then rs.MoveFirst Do While Not rs.EOF If Not FieldExists(rs, "QuestionID") Or Not FieldExists(rs, "Question") Or Not FieldExists(rs, "Answer") Or Not FieldExists(rs, "StartRow") Or Not FieldExists(rs, "StartCol") Or Not FieldExists(rs, "Direction") Then MsgBox "Error: One or more required fields are missing in the table " & Cnst_TableName_Questions, vbExclamation Exit Function End If intQuestionID = rs!QuestionID QuestionValue = rs!Question AnswerValue = Replace(rs!Answer, " ", "") StartRow = rs!StartRow StartCol = rs!StartCol Direction = rs!Direction For i = 0 To Len(AnswerValue) - 1 Dim controlName As String Dim characterID As Integer Dim currentChar As String currentChar = Mid(AnswerValue, i + 1, 1) ' Get the current character If strLanguage = "Arabic" Then If Direction = "Horizontal" Then controlName = "txt" & ((StartRow - 1) * intRowCellsNumber + (StartCol - i)) characterID = (StartRow - 1) * intRowCellsNumber + (StartCol - i) ElseIf Direction = "Vertical" Then controlName = "txt" & ((StartRow - 1 + i) * intRowCellsNumber + StartCol) characterID = (StartRow - 1 + i) * intRowCellsNumber + StartCol End If ElseIf strLanguage = "English" Then If Direction = "Horizontal" Then controlName = "txt" & ((StartRow - 1) * intRowCellsNumber + (StartCol + i)) characterID = (StartRow - 1) * intRowCellsNumber + (StartCol + i) ElseIf Direction = "Vertical" Then controlName = "txt" & ((StartRow - 1 + i) * intRowCellsNumber + StartCol) characterID = (StartRow - 1 + i) * intRowCellsNumber + StartCol End If End If With RSCrossword .FindFirst "characterID = " & characterID If Not .NoMatch Then .Edit !QuestionID = intQuestionID !AnswerChar = currentChar .Update End If End With If frm.Controls(controlName).Tag = "GridControl" Then frm.Controls(controlName).Value = currentChar End If Next i rs.MoveNext Loop End If rs.Close RSCrossword.Close Set rs = Nothing Set RSCrossword = Nothing Set db = Nothing Set frm = Nothing Exit Function UpdateGridWithWords_Error: Debug.Print "Error updating grid with words: " & Err.Number & " " & Err.Description End Function Public Sub RepaintAndProcessEvents(ByRef formOrControl As Object) ' Repaint the form or control formOrControl.Repaint ' Allow the system to process events DoEvents End Sub ولو سمعت حد بيقول عاوز شرح هاخد بعضى واروح العب فى حتة تانيه بهزر طبعا اللى عاوز شرح يتعب شوية ويحاول يحلل ويفهم ولما يعطل يسأل ما هو مش هأكتب الكود فى ساعات واشرحه فى ايام

طيب ممكن حضرتك تجربى الاتى اضافة الدالة الاتية فى وحدة نمطية Public Sub RepaintAndProcessEvents(ByRef formOrControl As Object) ' Repaint the form or control formOrControl.Repaint ' Allow the system to process events DoEvents End Sub وبعدين كود الحذف على زر الامر بالشكل ده Private Sub YourDeleteButton_Click() If MsgBox("Are you sure you want to delete the record?", vbYesNo, "Delete Confirmation") = vbYes Then DoCmd.SetWarnings (0) ' Query to delete records from test_order_tbl Dim strSQL1 As String strSQL1 = "DELETE FROM test_order_tbl " & _ "WHERE ID=" & Forms![reservation_frm]![ID] & ";" DoCmd.RunSQL strSQL1 ' Query to delete records from reservation_tbl Dim strSQL2 As String strSQL2 = "DELETE FROM reservation_tbl " & _ "WHERE ID=" & Forms![reservation_frm]![ID] & ";" DoCmd.RunSQL strSQL2 ' Requery to refresh the record list selected_list.Requery DoCmd.SetWarnings (1) ' Repaint the form and process events RepaintAndProcessEvents Me Else DoCmd.CancelEvent End If End Sub

شفاك الله وجمع لك بين الأجر والعافية .. طهور ان شاء الله عجزت ايه بس يا عم انت هتتدلع انشف كده 😡 ايه الجيل ده يا ربى

استاذى الجليل و معلمى القدير و والدى الحبيب الاستاذ @ابوخليل الموضوع اعتقد لا علاقة له بالحماية فالقاعدة المرفقة تم عملها بمحرك اكسس قديم والاصدارات الحديثة لا تستطيع التعامل معها او فتحها

يا دكتور انا عملت لحضرتك المرفق دع قبل كده لما دخلت اون لاين على الجهاز بتاع حضرتك لما قلنا لازم تلات قواعد قاعدة الجدول حتكون مشفرة بكلمة مرور وقاعدة النماذح كمان مشفرة بكلمة مرور وممكن تكون غير الاولى لو عاوز والقاعدة الثالثة المفتاح اللى بتفتح قاعدة الجداول وتمرر كلمات المرور وقلنا لو عاوزين محدش يعرف كلمات المرور نحول القاعدة الثالثة الى Accdb مرة على 32 بيت و مرة تانى على 64 بيت علشان تشتغل حسب النظام

طيب اتفضل يا سيدى اللبنة الاولى لـ Version 2.16 إن شاء الله الاول استخدم زر الامر Go To Crossword Setting بكده تروح لنموذج اعداد الاسئلة وعلشان تشوف الحلويات والجمال تعالى نرخم ع الاكسس علشان نخليه ينفذ طلباتنا : دوس ع الزرار Update Grid وبعد كده علشان تاخد لفة اغلق النموذج وروح للنموذج frmSplash البيانات اللى ظاهرة دى هى الاعدادت الحالية والتى تبين نوع اللغة لوضع الاسئلة والاجوبة وعدد مربعات الشبكة فى الصف الواحد والمرة دى اختر زر الامر New Setting Game من النموذج اللى حيفتح اختار شكل الشبكة ونوع اللغة وجرب اكتر من مره اه مفيش خدع ولا تركات ولا مربعات مخفيه ده بئه شغل فاخر من الاخر عاوز تشوف حلويات اكتر من كده روح يا سيدى وكمل لعب وامسح النموذج بتاع الشبكة خالص frmCrossword وبعد كده خد لفة تانى وروح للنموذج frmSplash والمرة دى برضو اختر زر الامر New Setting Game من النموذج اللى حيفتح اختار شكل الشبكة ونوع اللغة وجرب اكتر من مره وشوف نموذج frmCrossword هتلاقيه رجع تانى ما هو لازقه عامل زى القرش البرانى تخذفة وتمحيه يلف ويرجع لك تانى وكمل انت بقة اظن انا كده عملت معاك فوق الصح الباقى شوية ظبط عادى لا اكتر ولا اقل والموضوع سهل سهل خااااالص ولذيذ ولا اروع والله بجد وكده نقدر نقول نلعب ونتعلم ونتحدى نفسنا والاكسس وبكده انا فى انتظار رأى معلمى الجليل واستاذى القدير و والدى الحبيب الاستاذ @ابوخليل فى الافكار المتواضعة دى لعمل نسخة حبيننا الغالى الاستاذ @Moosak حققنا له حلمه فى عمل Version 2.16 إن شاء الله ؟ Officena Crossword Game.accdb

طيب استاذ @Moosak بما انك لك السبق فى هذا الموضوع بصراحة انا قبل فترة حاولت تصميم قاعدة وبسبب انشغالى فى العمل توقفت كالعادة ولكن بما ان استاذى الجليل ومعلمى القدير و والدى الحبيب الاستاذ @ابوخليل أعجبته الفكرة وكانت هذه كلماته بالعند فى استاذى الجليل ومعلمى القدير صاحب المكتبة العامرة الاستاذ @Moosak فى شغل احترافى زى القاعدة فى المشاركة الاصلية وفى شغل فاخر من الاخر ايون صدقنى زيمبئولك كده الشغل الفاخر من الاخر بقه لما تفتح القاعدة تحدد لغة الاسئلة والاجوبة عربى واللا انجليزى لانها تفرق طبعا فى اتجاه النص >>---> اومااااااااااااال وكمان تحدد اجمالى مربعات الشبكة ان هنا شايفها مثبته 10 * 10 تقريبا يكون فى مرونه فى وضع وتعديل الاسئلة والاجوبة واللا ايه الكلام ؟!