ابو جودي

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

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

باش مهندسة @hanan_ms برافو تسلم ايدك

هذه هى النتيجة المؤكده و هو الرد الطبيعى من مجرد طالب علم يتكبر بغرور وجهل احسنت

الاجابة الاصح والافضل اولا : كود الوحدة النمطية العامة تم اعادة هيكلة الكود وتعديله للتعامل مع النواتان بالطريقة الصحيحة على Option Compare Database Option Explicit #If VBA7 Or Win64 Then Private Declare PtrSafe Function CallNextHookEx Lib "user32" (ByVal hHook As LongPtr, ByVal ncode As LongPtr, ByVal wParam As LongPtr, lParam As Any) As LongPtr Private Declare PtrSafe Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As LongPtr Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As LongPtr, ByVal lpfn As LongPtr, ByVal hmod As LongPtr, ByVal dwThreadId As LongPtr) As LongPtr Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As LongPtr) As LongPtr Private Declare PtrSafe Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" (ByVal hDlg As LongPtr, ByVal nIDDlgItem As LongPtr, ByVal wMsg As LongPtr, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As LongPtr) As LongPtr Private Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As LongPtr #Else Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook as long, ByVal ncode as long, ByVal wParam as long, lParam As Any) as long Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) as long Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA"(ByVal idHook As LongPtr, ByVal lpfn As LongPtr, ByVal hmod As LongPtr, ByVal dwThreadId As LongPtr) As LongPtr Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook as long) as long Private Declare Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" (ByVal hDlg as long, ByVal nIDDlgItem as long, ByVal wMsg as long, ByVal wParam as long, ByVal lParam as long) as long Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd as long, ByVal lpClassName As String, ByVal nMaxCount as long) as long Private Declare Function GetCurrentThreadId Lib "kernel32" () as long #End If 'Constants to be used in our API functions Private Const EM_SETPASSWORDCHAR = &HCC Private Const WH_CBT = 5 Private Const HCBT_ACTIVATE = 5 Private Const HC_ACTION = 0 #If VBA7 Or Win64 Then Private hHook As LongPtr #Else Private hHook As Long #End If Public Function NewProc(ByVal lngCode As LongPtr, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr Dim RetVal Dim strClassName As String Dim lngBuffer As LongPtr If lngCode < HC_ACTION Then NewProc = CallNextHookEx(hHook, lngCode, wParam, lParam) Exit Function End If strClassName = String$(256, " ") lngBuffer = 255 If lngCode = HCBT_ACTIVATE Then RetVal = GetClassName(wParam, strClassName, lngBuffer) If Left$(strClassName, RetVal) = "#32770" Then SendDlgItemMessage wParam, &H1324, EM_SETPASSWORDCHAR, Asc("*"), &H0 End If End If CallNextHookEx hHook, lngCode, wParam, lParam End Function Public Function InputBoxDK(Prompt, Optional Title, Optional Default, Optional XPos, Optional YPos, Optional HelpFile, Optional Context) As String On Error GoTo ExitProperly Dim lngModHwnd As LongPtr Dim lngThreadID As LongPtr lngThreadID = GetCurrentThreadId lngModHwnd = GetModuleHandle(vbNullString) hHook = SetWindowsHookEx(WH_CBT, AddressOf NewProc, lngModHwnd, lngThreadID) InputBoxDK = InputBox(Prompt, Title, Default, XPos, YPos, HelpFile, Context) UnhookWindowsHookEx hHook ExitProperly: UnhookWindowsHookEx hHook End Function ثانيا الكود داخل النموذج المستهدف والذى تريد التعامل معه لابد ان يكون الكود على طريقة كبار المعلمين والمحترفين فى حدث ( فتح النموذج ) وليس حدث التحميل Private Sub Form_Open(Cancel As Integer) ' Exit if this is a new record Dim MyPass As String Dim TargetFormName As String ' Replace "TargetFormName" with the actual form name you want to open If Len(TargetFormName & "") = 0 Then TargetFormName = Me.Name ' Prompt user for the password MyPass = InputBoxDK("To open this form, you need to know the correct password to proceed with the opening process", "Confirm Opening a Secured Form") ' Check if the entered password is correct If MyPass = "123" Then If Len(TargetFormName & "") = 0 Then TargetFormName = Me.Name DoCmd.OpenForm TargetFormName ElseIf Len(MyPass & "") = 0 Then MsgBox "Form opening process canceled", vbInformation ' Display a message if the operation is canceled Cancel = True ' Cancel the form opening Else MsgBox "Incorrect password", vbExclamation ' Display a message if the password is incorrect Cancel = True ' Cancel the form opening End If End Sub واخيـرا: المرفق الصحيح ليكون مرجعا للدارسين وطلاب العلم test (3).accdb

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

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

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

هذه طريقتى المفضلة رقم سري.accdb

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

بسيطة تروحى للموضوعا هنا

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

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

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

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

اسف نست ارفع المرفق نوبتجيات 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 ايون ايه هى المشكلة طيب علشان افهم فى ايه ؟انا مش فاهم