ابو جودي

واضع ان التعديلات معجبتكش.. عندك حق تصدق انا كمان معجبتنيش

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

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

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

اسف نست ارفع المرفق نوبتجيات V. 2.zip

مبسوط كده يا عم @Foksh الباسورد : 1510 علشان متزعلش بس وعلشان فرحتك تتم كلمة المرور تظهر وتختفى زى الحلاوة والقايمة بتختفى يا عم وبردو مافيهاش ترميش ومن الكلام ده على الله بس تكون مبسوط معلش بئه يا @M.Abd Allah عدلت حبة حجات ثغننه ع السريع كده بس علشان @Foksh أفندى ينبسط

ممكن لما افضى العب شوية واعدل براحتى ؟ بس لما اخلص ما تتريقش على ولا على شغلى

قصدك 1510 ده

يعنى ع الاقل رد تقول الدنيا تمام واللا لاء

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

ممكن مرفق

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

طيب جربى الكود بالشكل ده وبعد التجربة فولى لى فى رسائل خطأ ظهرت معاكى واللا لاء 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 وطبعا بقول لك جربى لانى مش فاهم شئ والقاعدة مش قدامى يعنى ياريا لو تتكرمى وتتعطفى علينا بمرفق ثغنون كده