ابو جودي

طيب جربى الكود بالشكل ده وبعد التجربة فولى لى فى رسائل خطأ ظهرت معاكى واللا لاء Sub UpdateFields() On Error GoTo ErrorHandler OpenFormAndSetFields "PT_frm" Dim ptRValue As Variant Dim ptLValue As Variant Dim ptHValue As Variant Dim conc_rValue As Variant Dim INR_rValue As Variant Dim ratio_rValue As Variant Dim reference_value As Variant Dim gender As String Dim ageunit As String Dim normalType As String Dim age As Integer gender = Forms!pt_frm!gender age = Forms!pt_frm!age ageunit = Forms!pt_frm!ageunit normalType = DLookup("normal_type", "test_tbl", "tcode = 144") If normalType = "sex" Then If gender = "female" Then ptRValue = DLookup("rfemale", "test_tbl", "normal_type = 'sex' AND tcode = 144") ptLValue = DLookup("lfemale", "test_tbl", "normal_type = 'sex' AND tcode = 144") ptHValue = DLookup("hfemale", "test_tbl", "normal_type = 'sex' AND tcode = 144") conc_rValue = DLookup("rfemale", "test_tbl", "normal_type = 'sex' AND tcode = 145") INR_rValue = DLookup("rfemale", "test_tbl", "normal_type = 'sex' AND tcode = 146") ratio_rValue = DLookup("rfemale", "test_tbl", "normal_type = 'sex' AND tcode = 147") ElseIf gender = "male" Then ptRValue = DLookup("rmale", "test_tbl", "normal_type = 'sex' AND tcode = 144") ptLValue = DLookup("lmale", "test_tbl", "normal_type = 'sex' AND tcode = 144") ptHValue = DLookup("hmale", "test_tbl", "normal_type = 'sex' AND tcode = 144") conc_rValue = DLookup("rmale", "test_tbl", "normal_type = 'sex' AND tcode = 145") INR_rValue = DLookup("rmale", "test_tbl", "normal_type = 'sex' AND tcode = 146") ratio_rValue = DLookup("rmale", "test_tbl", "normal_type = 'sex' AND tcode = 147") End If ElseIf normalType = "sex and age" Then reference_value = DLookup("Reference", "normals_tbl", _ "Gender = '" & Forms("pt_frm")("gender").Value & "' AND " & _ "Ageunit = '" & Forms("pt_frm")("ageunit").Value & "' AND " & _ "tcode = 144 AND " & _ Forms("pt_frm")("age").Value & " BETWEEN [from] AND [to]") If Not IsNull(reference_value) Then Forms("pt_frm")("pt_r").Value = reference_value Else MsgBox "لم يتم العثور على قيمة مرجعية للشروط المحددة.", vbExclamation End If End If Forms!pt_frm!pt_r.Value = ptRValue Forms!pt_frm!pt_h.Value = ptHValue Forms!pt_frm!pt_l.Value = ptLValue Forms!pt_frm!conc_r.Value = conc_rValue Forms!pt_frm!inr_r.Value = INR_rValue Forms!pt_frm!ratio_r.Value = ratio_rValue Forms!pt_frm!pt_u.Value = DLookup("unit", "test_tbl", "normal_type = '" & normalType & "' AND tcode = 144") Forms!pt_frm!Control.Value = DLookup("default", "test_tbl", "normal_type = '" & normalType & "' AND tcode = 148") Forms!pt_frm!conc_u.Value = DLookup("unit", "test_tbl", "normal_type = '" & normalType & "' AND tcode = 145") Forms!pt_frm!inr_u.Value = DLookup("unit", "test_tbl", "normal_type = '" & normalType & "' AND tcode = 146") Forms!pt_frm!ratio_u.Value = DLookup("unit", "test_tbl", "normal_type = '" & normalType & "' AND tcode = 147") Exit Sub ErrorHandler: MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical End Sub

ويعنى انا مش عاجبنى اننا نستخدم DLookup دى كتير بالشكل ده ده يأثر على كفاءة وسرعة الاداء وممكن نستخدم مصفوفة وده هيكون شكل الكود بعد التعديل باستخدام المصفوفة لتخزين أكواد الاختبار مع حلقة For لتمرير القيم إلى الحقول Private Sub OpenFormAndSetFields(formName As String) DoCmd.OpenForm formName, , , "[ID]=" & Me.ID With Forms(formName) .ID = Me.ID .pname = Forms![visit_frm]![pname] .gender = Forms![visit_frm]![gender] .age = Forms![visit_frm]![age] .code = Forms![visit_frm]![code] .vdate = Forms![visit_frm]![vdate] .ageunit = Forms![visit_frm]![ageunit] .tcode = Me.tcode .Sub = Me.test .dtitle = Me.Parent![dtitle] .ref_by = Me.Parent![ref_by] .ptitle = Me.Parent![ptitle] End With End Sub Dim gender As String Dim age As Integer Dim ageunit As String Dim ptValues As Variant Dim normalType As String OpenFormAndSetFields "PT_frm" If Not CurrentProject.AllForms("PT_frm").IsLoaded Then MsgBox "نموذج PT_frm غير مفتوح.", vbExclamation Exit Sub End If With Forms("PT_frm") gender = .gender age = .age ageunit = .ageunit End With normalType = DLookup("normal_type", "test_tbl", "tcode = 144") If normalType = "sex" Then Dim fieldPrefix As String If gender = "female" Then fieldPrefix = "rfemale" ElseIf gender = "male" Then fieldPrefix = "rmale" End If ' مصفوفة لتخزين القيم ptValues = Array(144, 145, 146, 147) Dim i As Integer For i = LBound(ptValues) To UBound(ptValues) Select Case ptValues(i) Case 144 Forms("PT_frm")!ptRValue = DLookup(fieldPrefix, "test_tbl", "normal_type = 'sex' AND tcode = 144") Forms("PT_frm")!ptLValue = DLookup(fieldPrefix, "test_tbl", "normal_type = 'sex' AND tcode = 144") Forms("PT_frm")!ptHValue = DLookup(fieldPrefix, "test_tbl", "normal_type = 'sex' AND tcode = 144") Case 145 Forms("PT_frm")!conc_rValue = DLookup(fieldPrefix, "test_tbl", "normal_type = 'sex' AND tcode = 145") Case 146 Forms("PT_frm")!INR_rValue = DLookup(fieldPrefix, "test_tbl", "normal_type = 'sex' AND tcode = 146") Case 147 Forms("PT_frm")!ratio_rValue = DLookup(fieldPrefix, "test_tbl", "normal_type = 'sex' AND tcode = 147") End Select Next i ElseIf normalType = "sex and age" Then Dim reference_value As Variant reference_value = DLookup("Reference", "normals_tbl", _ "Gender = '" & gender & "' AND " & _ "Ageunit = '" & ageunit & "' AND " & _ "tcode = 144 AND " & _ age & " >= [from] AND " & age & " <= [to]") If Not IsNull(reference_value) Then Forms("PT_frm")!pt_r1.Value = reference_value Else MsgBox "لم يتم العثور على قيمة مرجعية للشروط المحددة.", vbExclamation End If End If ايون ايه هى المشكلة طيب علشان افهم فى ايه ؟انا مش فاهم

جربى الكود ده ولو سمحتى انا بكلمنيش فمتخلنيش اتكلم من غير كلام ماشى Private Sub OpenFormAndSetFields(formName As String) DoCmd.OpenForm formName, , , "[ID]=" & Me.ID With Forms(formName) .ID = Me.ID .pname = Forms![visit_frm]![pname] .gender = Forms![visit_frm]![gender] .age = Forms![visit_frm]![age] .code = Forms![visit_frm]![code] .vdate = Forms![visit_frm]![vdate] .ageunit = Forms![visit_frm]![ageunit] .tcode = Me.tcode .Sub = Me.test .dtitle = Me.Parent![dtitle] .ref_by = Me.Parent![ref_by] .ptitle = Me.Parent![ptitle] End With End Sub Dim gender As String Dim age As Integer Dim ageunit As String Dim ptRValue As Variant Dim ptLValue As Variant Dim ptHValue As Variant Dim conc_rValue As Variant Dim INR_rValue As Variant Dim ratio_rValue As Variant Dim normalType As String OpenFormAndSetFields "PT_frm" If Not CurrentProject.AllForms("PT_frm").IsLoaded Then MsgBox "نموذج PT_frm غير مفتوح.", vbExclamation Exit Sub End If With Forms("PT_frm") gender = .gender age = .age ageunit = .ageunit End With normalType = DLookup("normal_type", "test_tbl", "tcode = 144") If normalType = "sex" Then If gender = "female" Then ptRValue = DLookup("rfemale", "test_tbl", "normal_type = 'sex' AND tcode = 144") ptLValue = DLookup("lfemale", "test_tbl", "normal_type = 'sex' AND tcode = 144") ptHValue = DLookup("hfemale", "test_tbl", "normal_type = 'sex' AND tcode = 144") conc_rValue = DLookup("rfemale", "test_tbl", "normal_type = 'sex' AND tcode = 145") INR_rValue = DLookup("rfemale", "test_tbl", "normal_type = 'sex' AND tcode = 146") ratio_rValue = DLookup("rfemale", "test_tbl", "normal_type = 'sex' AND tcode = 147") ElseIf gender = "male" Then ptRValue = DLookup("rmale", "test_tbl", "normal_type = 'sex' AND tcode = 144") ptLValue = DLookup("lmale", "test_tbl", "normal_type = 'sex' AND tcode = 144") ptHValue = DLookup("hmale", "test_tbl", "normal_type = 'sex' AND tcode = 144") conc_rValue = DLookup("rmale", "test_tbl", "normal_type = 'sex' AND tcode = 145") INR_rValue = DLookup("rmale", "test_tbl", "normal_type = 'sex' AND tcode = 146") ratio_rValue = DLookup("rmale", "test_tbl", "normal_type = 'sex' AND tcode = 147") End If ElseIf normalType = "sex and age" Then Dim reference_value As Variant reference_value = DLookup("Reference", "normals_tbl", _ "Gender = '" & gender & "' AND " & _ "Ageunit = '" & ageunit & "' AND " & _ "tcode = 144 AND " & _ age & " >= [from] AND " & age & " <= [to]") If Not IsNull(reference_value) Then Forms("PT_frm")("pt_r1").Value = reference_value Else MsgBox "لم يتم العثور على قيمة مرجعية للشروط المحددة.", vbExclamation End If End If انا مش فاهم حاجة على فكرة انا الاول حاولت ارتب الكود على قد ما قدرت علشان تجربى وتقولى لى فى ايه

هههههه مكتبتة دائما عامرة ما شاء الله 🧐 مش بأحسد ولا حاجة بس اقصد الدعوة مجابة اصلا ماشاء الله قبل الدعاء

يا راجل مش تقول من بدرى يا نهار ابيض ع العموم اجابة السؤال كاملة اهى علشان الميزانية بس <---<< الشق الاول Private Sub cmb_TQ_AfterUpdate() ' Declare variables Dim db As DAO.Database Dim tableDef As DAO.tableDef Dim field As DAO.field Dim fieldCaption As String Dim fieldCaptions() As String Dim fieldIndex As Integer ' Get the current database Set db = CurrentDb ' Get the selected table definition Set tableDef = db.TableDefs(Me.cmb_TQ.Value) ' Clear the contents of the current listbox Me.ListFields.RowSource = "" ' Set the number of columns to 1 Me.ListFields.columnCount = 1 ' Initialize the array to store captions or field names ReDim fieldCaptions(tableDef.Fields.Count - 1) ' Loop through each field in the table definition fieldIndex = 0 For Each field In tableDef.Fields ' Check if the Caption property exists and use it; otherwise, use the field name If FieldHasCaption(field) Then fieldCaption = field.Properties("Caption") Else fieldCaption = field.Name End If ' Add the caption or field name to the array fieldCaptions(fieldIndex) = fieldCaption fieldIndex = fieldIndex + 1 Next field ' Set the row source for the ListFields control Me.ListFields.RowSourceType = "Value List" Me.ListFields.RowSource = Join(fieldCaptions, ";") ' Clear memory Set db = Nothing Set tableDef = Nothing End Sub ' Function to check if a field has a Caption property ' Input: field (DAO.Field) - The field to check for a caption ' Output: Boolean - True if the field has a caption, False otherwise Private Function FieldHasCaption(field As DAO.field) As Boolean On Error Resume Next FieldHasCaption = Not IsNull(field.Properties("Caption")) On Error GoTo 0 End Function اما الشق التانى : ومتقوليش شرح علشان مش فاضى والله بقدر الامكان هتلاقى شرح ع الكود انا عملت لك زر امر جديد هيكون اسمه : btnExport والكود بتاعه اهو Private Sub btnExport_Click() On Error GoTo ErrorHandler ' Declare variables Dim sqlStatement As String Dim selectedFields As String Dim fieldIndex As Long Dim fieldName As String Dim field As DAO.field Dim tableName As String Dim db As DAO.Database Dim tableOrQuery As Object Dim fieldCaptionDict As Object Dim fieldCaption As String Dim selectedFieldCount As Integer ' Create a dictionary to store field captions and names Set fieldCaptionDict = CreateObject("Scripting.Dictionary") ' Check if a table or query is selected If Len(Me.cmb_TQ & "") = 0 Then MsgBox "Please select Table or Query" Me.cmb_TQ.SetFocus Exit Sub End If tableName = Me.cmb_TQ ' Check if the table or query exists in the database Set db = CurrentDb On Error Resume Next Set tableOrQuery = db.TableDefs(tableName) If tableOrQuery Is Nothing Then ' If it's not a table, check the queries Set tableOrQuery = db.QueryDefs(tableName) End If On Error GoTo ErrorHandler If tableOrQuery Is Nothing Then MsgBox "The table or query '" & tableName & "' does not exist." Exit Sub End If ' Populate the dictionary with field captions and names For Each field In tableOrQuery.Fields On Error Resume Next fieldCaption = field.Properties("Caption") On Error GoTo 0 If IsNull(fieldCaption) Then fieldCaption = field.Name End If If Not fieldCaptionDict.Exists(fieldCaption) Then fieldCaptionDict.Add fieldCaption, field.Name End If Next field ' Check selected fields in the listbox selectedFields = "" selectedFieldCount = 0 For fieldIndex = 0 To Me.ListFields.ListCount - 1 If Me.ListFields.Selected(fieldIndex) Then fieldCaption = Me.ListFields.Column(0, fieldIndex) ' assuming column 0 contains the captions If fieldCaptionDict.Exists(fieldCaption) Then fieldName = fieldCaptionDict(fieldCaption) Else fieldName = fieldCaption End If ' Add the field to the selected fields string selectedFields = selectedFields & fieldName & ", " selectedFieldCount = selectedFieldCount + 1 End If Next fieldIndex ' Remove the trailing comma from the selected fields string If Len(selectedFields) > 0 Then selectedFields = Left(selectedFields, Len(selectedFields) - 2) Else ' If no fields are selected, select all fields selectedFields = "*" End If ' Print the selected field names Debug.Print "Selected Fields: " & selectedFields ' Build the SQL statement based on the selected fields sqlStatement = "SELECT " & selectedFields & " FROM " & tableName ' Print the SQL statement Debug.Print "SQL Statement: " & sqlStatement ' Set the SQL statement as the data source for the SearchListEXP textbox Me.SearchListEXP.RowSourceType = "Table/Query" Me.SearchListEXP.RowSource = sqlStatement ' Update the number of columns in SearchListEXP Me.SearchListEXP.columnCount = selectedFieldCount ' Set the column headers Me.SearchListEXP.ColumnHeads = True Me.SearchListEXP.ColumnWidths = "2in" ' Adjust as needed ' Requery the data Me.SearchListEXP.Requery Exit Sub ErrorHandler: MsgBox "Error " & Err.Number & ": " & Err.Description DoCmd.Hourglass False End Sub على الله بقة مانتلككش تانى ونخلص بئه ونسلم الشغل بسرعة علشان الميزانية تقبل تحياتى

عروستى لا يا راجل والله فهمت انا كده بئه صح يا جدعان وربنا انا صعيدى انتو مش عاوزين تصدقوا ليه

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

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

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

انصحك بشدة قم بالغاء تنصيب الاوفيس 2016 لكن وركز معايا فـ ولاكن دى استخدم برناامج you uninstall حتى تقوم بحذف الاوفيس من جذوره هو وكل ملفات الريجسترى الخاصة به وانصحك بشئ من اتنين الافضل اوفيس 2010 مع ويندوز 7 سوف تجد فارق كبير جدا جدا جدا فى التعامل الحل التانى تشيل الويندوز 7 تفرمت ال C تنزل نسخة ويندوز وعندى ليك نسخة حلوه ومحترمة جدا جدا وخفيفة جدا جدا جدا وعن تجربة اسمها windows 10 ghost spectre لو عاوز تعرف عنها اكتر قولى اوفر لك فيديوز لشرحها ورابط تحميلها بكل سهولة وبعد الويندوز دى اشتغل بأوفيس Office 2021 LTSC وهتدعى لى ولو عاوز اى مساعدة اونلاين ممكن ابقى ادخل معاك على جهازك ريموت واساعدك فى اى شئ من خلال AnyDesk

هههههه انا قلت @Foksh هيزعق لى ويدينى بالمجهر فى دماغى ويعيط ويدبدب برجله زى ناس اسمها @safaa salem5 وفى الاخر يقولى انا مش داخل هنا تانى ومش عاوز منك حاجة وهروح عند الاجانب انا راضى زمتكم الاجانب عندهم @Moosak صاحب المكتبة العامرة واللا عندهم @Foksh ابو قلب ابيض العسل ده والا عندهم واحدة بتكلم العرب بالعربى والعرب عاوزين مترجم علشان يفهموها اسمها الباش مهندس @hanan_ms حتة واحدة وبتفضل تحط مرفقات تخبل وتجنن وفيها اخترعات غريبة من كوكب تانى اه والله زيمبئولكم كده روحوا شوفوا شغلها يجنن بس اتفرجوا على الشغل هلى طول بدون ما تقرأوا كلامها والله احلى صحبة هنا ناس عسل مالهومش زى احل اخل واخوات فى الدنيا واعظم اساتذة فى الوجود ال مش لاعبه هنا تانى واروح العب عند الاجانب قال روحى يا اختى

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

جربى الكود ده كده Dim reference_value As Variant Dim gender As String Dim ageUnit As String Dim age As Integer gender = Forms("pt_frm")("gender").Value ageUnit = Forms("pt_frm")("ageunit").Value age = Forms("pt_frm")("age").Value reference_value = DLookup("Reference", "normals_tbl", _ "Gender = '" & gender & "' AND " & _ "Ageunit = '" & ageUnit & "' AND " & _ "tcode = 144 AND " & _ age & " >= [from] AND " & _ age & " <= [to]") If Not IsNull(reference_value) Then Forms!pt_frm!pt_r.Value = reference_value End If وطبعا بقول لك جربى لانى مش فاهم شئ والقاعدة مش قدامى يعنى ياريا لو تتكرمى وتتعطفى علينا بمرفق ثغنون كده

هههههههه مش حقول لك

لاحظى ان كلامك جارح وبتحكى عنى انا مش البعض انا كلهم

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

طيب الكودين تحت المجهر >>-----> الكود الاول للاستاذ العظيم @Foksh والكود الثانى اللى هو احسن طبعا <<----< مين يشهد للعروسة الكود الاول : استخدام AddItem لإضافة العناصر بشكل فردي بدلا من بناء سلسلة نصية يقوم الكود بإضافة أسماء الحقول إلى قائمة ListFields بشكل فردي باستخدام AddItem عدم التعامل مع الأخطاء الكود لا يحتوي على أي تعامل مع الأخطاء مما قد يسبب أخطاء غير متوقعة إعداد RowSource في بداية العملية يتم إعداد RowSource وإفراغه قبل البدء في إضافة العناصر عدم استخدام جملة sql جملة sql الموجودة في الكود لا تؤثر على الكود ويمكن إزالتها لأنها غير مستخدمة الكود الثانى : استخدام متغير rowSourceString لبناء قائمة ListFields الكود يجمع كل أسماء الحقول في سلسلة نصية مفصولة بفواصل إعداد RowSource مباشرة بسلسلة نصية في النهاية حيث يقوم الكود بإعداد RowSource لقائمة ListFields باستخدام السلسلة النصية التي تم بناؤها التعامل مع الأخطاء بشكل آمن يتم التعامل مع الأخطاء عند محاولة الوصول إلى خاصية "Caption" في الحقول بشكل آمن عبر استخدام On Error Resume Next ثم On Error GoTo 0 بعد محاولة الوصول مسح الذاكرة بشكل صحيح: يتم تعيين المتغيرات db و td إلى Nothing في النهاية، مما يساعد على تحرير الذاكرة. المرونة والأداء: الكود الثانى قد يكون أفضل من حيث الأداء ده كده كده لانه بتاعى بالعند فيك يا استاذ @Foksh حيث يتم بناء السلسلة النصية مرة واحدة ثم تعيينها إلى RowSource بدلاً من إضافة العناصر بشكل فردي كما في الكود الاول فى الكود الثانى يتم التعامل مع الأخطاء بشكل صحيح مما يجعله نسبيا ً أكثر استقراراً وضوح الكود : الكود الثانى أكثر وضوحاً وسهولة في الفهم ده كده كده برضو لتانى مرة حيث يتم جمع أسماء الحقول ثم تعيينها دفعة واحدة بدلاً من الإضافة الفردية الخلاصة بقة لان ده شغل فاخر من الاخر : الكود الثانى يعتبر أفضل بسببين بس بعد الرغى ده كله ومعاكسة اغلى الغوالى 1- تعامله الأفضل مع الأخطاء 2- فعاليته في الأداء من خلال إعداد RowSource دفعة واحدة ووضوحه في التنفيذ من غير ما تدخل تزعق يا عم @Foksh هدى اعصابك بس روح ع الجدول وامسح اى تسمية لاى حقل وجرب

الشرح : - تعريف المتغيرات اللازمة ' Declare variables Dim db As DAO.Database Dim td As DAO.TableDef Dim fld As DAO.Field Dim fldCaption As String Dim rowSourceString As String - الحصول على قاعدة البيانات الحالية وتعريف الجدول ' Get the current database Set db = CurrentDb ' Get the selected table definition Set td = db.TableDefs(Me.cmb_TQ.Value) - إفراغ محتويات القائمة الحالية وتعيين عدد الأعمدة إلى 1 ' Clear the contents of the current listbox Me.ListFields.RowSource = "" ' Set the number of columns to 1 Me.ListFields.ColumnCount = 1 - بناء سلسلة النصوص التي تحتوي على التسميات أو أسماء الحقول ' Initialize the string to build captions or field names rowSourceString = "" ' Loop through each field in the table definition For Each fld In td.Fields ' Check if the Caption property exists and use it; otherwise, use the field name On Error Resume Next fldCaption = fld.Properties("Caption") On Error GoTo 0 If IsNull(fldCaption) Or fldCaption = "" Then fldCaption = fld.Name End If ' Add the caption or field name to the string rowSourceString = rowSourceString & fldCaption & ";" Next fld - إزالة الفاصلة الزائدة من نهاية السلسلة ' Remove the trailing semicolon from the end of the string If Len(rowSourceString) > 0 Then rowSourceString = Left(rowSourceString, Len(rowSourceString) - 1) End If - تعيين مصدر الصفوف للتحكم ListFields ' Set the row source for the ListFields control Me.ListFields.RowSourceType = "Value List" Me.ListFields.RowSource = rowSourceString - تحرير الذاكرة ' Clear memory Set db = Nothing Set td = Nothing - التحقق من وجود التسمية ' Check if the Caption property exists If FieldHasCaption(fld) Then fldCaption = fld.Properties("Caption") Else fldCaption = fld.Name End If - عمل دالة للتحقق من وجود التسمية Private Function FieldHasCaption(fld As DAO.Field) As Boolean On Error Resume Next FieldHasCaption = Not IsNull(fld.Properties("Caption")) On Error GoTo 0 End Function - استخدام مصفوفة لتخزين أسماء الحقول ومن ثم تعيين مصدر الصفوف مرة واحدة Dim captions() As String Dim i As Integer ReDim captions(td.Fields.Count - 1) ' Loop through each field in the table definition i = 0 For Each fld In td.Fields ' Check if the Caption property exists and use it; otherwise, use the field name If FieldHasCaption(fld) Then fldCaption = fld.Properties("Caption") Else fldCaption = fld.Name End If captions(i) = fldCaption i = i + 1 Next fld ' Set the row source for the ListFields control Me.ListFields.RowSourceType = "Value List" Me.ListFields.RowSource = Join(captions, ";") المميزات إضافة الدالة FieldHasCaption والتى تتحقق من وجود خاصية "Caption" بطريقة احترافية استخدام مصفوفة لتخزين أسماء الحقول ومن ثم تعيين مصدر الصفوف مرة واحدة لتحسين الأداء بس خلاص

بس كده غالى والطلب رخيص من عيونى الجوز انت تأمر اتفضل الكود اهو يا قمر Private Sub cmb_TQ_AfterUpdate() ' Declare variables Dim db As DAO.Database Dim td As DAO.TableDef Dim fld As DAO.Field Dim fldCaption As String Dim captions() As String Dim i As Integer ' Get the current database Set db = CurrentDb ' Get the selected table definition Set td = db.TableDefs(Me.cmb_TQ.Value) ' Clear the contents of the current listbox Me.ListFields.RowSource = "" ' Set the number of columns to 1 Me.ListFields.ColumnCount = 1 ' Initialize the array to store captions or field names ReDim captions(td.Fields.Count - 1) ' Loop through each field in the table definition i = 0 For Each fld In td.Fields ' Check if the Caption property exists and use it; otherwise, use the field name If FieldHasCaption(fld) Then fldCaption = fld.Properties("Caption") Else fldCaption = fld.Name End If ' Add the caption or field name to the array captions(i) = fldCaption i = i + 1 Next fld ' Set the row source for the ListFields control Me.ListFields.RowSourceType = "Value List" Me.ListFields.RowSource = Join(captions, ";") ' Clear memory Set db = Nothing Set td = Nothing End Sub Private Function FieldHasCaption(fld As DAO.Field) As Boolean On Error Resume Next FieldHasCaption = Not IsNull(fld.Properties("Caption")) On Error GoTo 0 End Function

طيب قبل ما احاول عمل اى شئ ممكن تقولى استخدام النموذج بالتفصيل ؟؟ يعنى انت عامل النموذج للحث من خلال مربعات السرد وايضا اضافة بيانات جديدة من خلال المربعات ؟؟؟ امممم وشئ تانى لاحظته فى النرفق الاخير هو لو عدلت المنصب فى اى سجل تم ادخاله وحفظه فى القاعدة باضافة شئ او متابته من مربع السرد هل انت موافق انه يتم تعديله فى الجدول اللى باسم المنصب باللغة العربية ؟؟ فيكون عندك منصب فيه جديد وغير موجود فى جدول المنصب باللغة الانجليوية واللى اسمه Tbl_Manaseb اممممممم قاعدة البيانات تحتاج الى شئ واحد فقط اجتياح >>---> انسف حمامك القديم لو تم البناء على اساس صحيح يعيش البناء ويستمر اما بهذا الشكل لا انصحك بالاستمرار على هذا الاساس الهش ولا تكمل بهذه الطريقة هتتعب قوى وكتير

شكل الكود هاد ما بيحب احمد هاهاههاا شوفتوا بقه فايدة ان الواحد يبقى اسمه محمد عن نفسي انا كمحمد مبسوط والله

يا استاذ @ahmed_204079 افندى المرفق اللى حضرتك وضعته مش بتاعك لان فى اكواد غلط وفى حجات ناقصة و و بلا بلا بلا...... ارجو منك لو تكرمت وفضلا وليس امرا لو المرفق الاساسى لموضوع التصدير موجود بدون التعديلات اللى خربت الدنيا فيه دى ارجوك ارفقه لانى محتاج اذاكره وكنت جهزت لك موضوع الليست بوكس وعلى ما رجعت من الشغل جيت ارفقه لاقيت اخونا الهمام الله يبارك بعمره الاستاذ @Foksh قام بالواجب على اكمل وجه الله يبارك له

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

تمعن فى هذا الجمال بدلا من ذلك العناء مع iif Switch( [ASNAF.UNIT] = [SAP.UNIT], "YYY", [ASNAF.UNIT] = [SAP.ADDITION UNIT], "YYY",True, "NNN" ) والله دالة سويتش جميلة وبنت حلال ليه تتجاهلونها يا اخوان عمالة تشتكى لى وتعيط منكم ده حتى كمان طيبة ومسكينة و لا تقلب الدنيا راسا على عقب لو تم استخدامها مع اللغة العربية بعكس بنت اللذينة iif دى اه والله زيمبئولكم كده بالمناسبة انا كاتبها صح مش غلط بس قاصد كتابتها كده علشان تشوفوا سهولة كتابتها عند الاستخدام وعلى سطر واحد تكون Switch([ASNAF.UNIT] = [SAP.UNIT], "YYY", [ASNAF.UNIT] = [SAP.ADDITION UNIT], "YYY", True, "NNN") وكما تلاحظون تكتب مرة واحدة بس لو هتعمل ميت شرط بطريقة اكثر تعقيدا ناهيك عن عدد مرات استخدام iif مع الشروط وعدد الاقواس وترتيبها

ارفق القاعدتان