Foksh

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

من تواضع لله رفعه ، وانت من الأساتذة الذين لهم بصماتهم وأسلوبهم

وعليكم السلام ورحمة الله وبركاته ,, ملف قيم وهام لمن يبحث عن المعلومة المفيدة . واحتواءه على روابط مراجع جميل جداً بتوسيع الفكرة والبحث الشامل عن معلومات تفيد صاحبها . الشكر موصول لصاحب القلم الأستاذ عارف حسان .

أهلا بأخي @ناقل ، يسعدني مرورك وتعقيبك على الموضوع ، رغم انك تسرعت في الحكم علي 😁😁 بالعكس ، أساتذتي الخبراء من المستهدفين بالمشاركة في هذا النقاش ( طبعاً مع احترامي الكامل لحرية ابداء الرأي ) ، انظر .. وتعقيباً على ما أسلفت تالياً :- ففي الحسبان ان شاء الله ، ولكن الصورة والفكرة السابقة من الإصدار الأول للتجارب الأولى لجمع التعليقات والمعلومات التي نستفيد منها .. معلمي الفاضل @ابوخليل ، أُسعد بمشاركتكم ، واتمنى أن أصل في النهاية إلى أداة تحقق الجزء الأكبر من فكرتها وهدفها .. بانتظار توجيهاتكم وإفاداتكم وتصويبكم لي لطرق تسهم في إنجاح المشروع .. معلمي الفاضل @jjafferr ، يسعدني توجيهكم لي بهذه الروابط ، وانا فعلاً قد قرأتها بشكل غير مفصل ، ولكن قراءتي لها كانت محاولة لرسم خطواتي التي سأبدأ بها ، وطبعاً لا بد من تغيير اتجاهي في الوقت الحالي واتجاه بوصلتي ، طبعاً بهدف البدء بخطوات صحيحة تالياً .. أما فيما يخص الكود الذي استخدمته كتجربه ، فيسعدني توجيهك من موقع مايكروسوفت ، دلالة على أن المصادر التي يجب علي اتباع نهجها يجب أن تكون موثوقة لاحقاً .. أخي الأستاذ @kkhalifa1960 ، يسعدني تعليقكم ومروركم ، وإثراءكم وملاحظتكم كثيراً .. ونأمل أن نتعرف على أفكاركم لاحقاً باحثين عن سبيل واسع الأفق لتحقيق المطلوب . أما فيما يخص هذا الجزء .. فطبعاً صديقي وحبيبي @ابو جودي ، من الذين أشاركهم أفكاري وأستنير بتعليقاتهم ، حاله حال أساتذتي ومعلميني الأفاضل ( دون استثناء طبعاً ) . لكن وضعه الحالي الصحي قد يجعل تعليقاته متاحة فيما بيننا خارج المنتدى . ( يعاني من كسر في يده اليمنى حالياً شافاه الله وعافاه شفاء عاجل غير آجل ) . وباسمي وباسم المنتدى نيابةً نتمنى له الشفاء القريب بإذن الله . أشكر لكم جميعاً مروركم وقريباً سنبدأ بطرح الفكرة من بدايتها ( النسخة الأولى من الأداة ) ، ومع توجيهاتكم معلميني وأساتذتي وأخواني ، سنبدأ بتصحيح المسارات الخاطئة عند وجودها وإنجاح الفكرة .

السلام عليكم ورحمة الله وبركاته ،، في طور تحسين الأداة الجديدة ( لم يعلن عنها بعد ) ، للتعامل مع الأكواد التي تعمل على 32 ولا تعمل على 64 ، ما زال العمل جاري على تحسين أداء الأداة ، بحيث من خلال النقاش المفتوح نأتي للوصول الى أفضل أداء ونتيجة . مرفق صورة توضيحية للوضع الحالي للأداة ، مع طرح مثال لكود قبل وبعد التحويل الناتج من الأداة . الكود الذي تمت التجربة عليه كمثال ( لا الحصر ) :- Option Compare Database Option Explicit Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" _ (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As _ Any) As Long Public Const WM_SETREDRAW = &HB Public Sub FillChildren(twTree As MSComctllib.TreeView, rst As dao.Recordset, _ ByVal nChild As MSComctllib.nodX, _ strParentField As String, strIDField As String, _ strTextField As String, Optional strTextField2 As Variant, Optional strTextField3 As Variant, Optional strTextField4 As Variant, Optional strTextField5 As Variant, _ Optional strKeyPrefix As String, _ Optional varImage As Variant, _ Optional varImageRst As Variant, _ Optional fBold As Boolean) On Local Error GoTo FillChildren_Err Dim strCriteria As String, IMAGE As Variant, strPrefix As String, strText As String, newnodx As MSComctllib.nodX If strKeyPrefix = "" Then strPrefix = "a" Else strPrefix = strKeyPrefix End If If Mid(nChild.key, 2) = "0" Then strCriteria = BuildCriteria(strParentField, rst.Fields(strParentField).Type, "=" & Mid(nChild.key, 2) & " or is null") Else strCriteria = BuildCriteria(strParentField, rst.Fields(strParentField).Type, "=" & Mid(nChild.key, 2)) End If rst.FindFirst strCriteria Do Until rst.NoMatch strText = Nz(rst(strTextField), " ") If Not IsMissing(strTextField2) Then strText = strText & (" " + rst(strTextField2)) If Not IsMissing(strTextField3) Then strText = strText & (" " + rst(strTextField3)) If Not IsMissing(strTextField4) Then strText = strText & (" " + rst(strTextField4)) If Not IsMissing(strTextField5) Then strText = strText & (" " + rst(strTextField5)) If Not IsMissing(varImageRst) Then IMAGE = rst(varImageRst) End If If (Not IsMissing(varImage)) And (Len(Nz(IMAGE)) = 0) Then IMAGE = varImage End If IMAGE = Nz(IMAGE, "Default") Set newnodx = twTree.Nodes.Add(nChild, tvwChild, strPrefix & rst(strIDField), strText, IMAGE) rst.FindNext strCriteria Loop FillChildren_End: On Error Resume Next Exit Sub FillChildren_Err: Select Case Err.Number Case 35601, 35603 'Image not found!!! IMAGE = "FlagDefault" Resume Case 35602 'key not unique!!! Set newnodx = twTree.Nodes(strPrefix & rst(strIDField)) Resume Next Case Else MsgBox "Error in FillChildren!!! " & Err.Number & Err.Description Stop Resume End Select End Sub النتيجة من الأداة بعد التحسينات والتعديلات :- 'Code converted to 64-bit compatibility By Foksh ( Officena.Net ) 'Generated on: 2025-05-23 15:22:26 'Tool version: Ver : 1.0 Option Compare Database Option Explicit #If VBA7 Then Public Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As LongPtr, ByVal wParam As Long, lParam As Any) As Long #Else Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" _ (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long #End If Public Const WM_SETREDRAW = &HB Public Sub FillChildren(twTree As MSComctllib.TreeView, rst As dao.Recordset, _ ByVal nChild As MSComctllib.nodX, _ strParentField As String, strIDField As String, _ strTextField As String, Optional strTextField2 As Variant, Optional strTextField3 As Variant, Optional strTextField4 As Variant, Optional strTextField5 As Variant, _ Optional strKeyPrefix As String, _ Optional varImage As Variant, _ Optional varImageRst As Variant, _ Optional fBold As Boolean) On Local Error GoTo FillChildren_Err Dim strCriteria As String, IMAGE As Variant, strPrefix As String, strText As String, newnodx As MSComctllib.nodX If strKeyPrefix = "" Then strPrefix = "a" Else strPrefix = strKeyPrefix End If If Mid(nChild.key, 2) = "0" Then strCriteria = BuildCriteria(strParentField, rst.Fields(strParentField).Type, "=" & Mid(nChild.key, 2) & " or is null") Else strCriteria = BuildCriteria(strParentField, rst.Fields(strParentField).Type, "=" & Mid(nChild.key, 2)) End If rst.FindFirst strCriteria Do Until rst.NoMatch strText = Nz(rst(strTextField), " ") If Not IsMissing(strTextField2) Then strText = strText & (" " + rst(strTextField2)) If Not IsMissing(strTextField3) Then strText = strText & (" " + rst(strTextField3)) If Not IsMissing(strTextField4) Then strText = strText & (" " + rst(strTextField4)) If Not IsMissing(strTextField5) Then strText = strText & (" " + rst(strTextField5)) If Not IsMissing(varImageRst) Then IMAGE = rst(varImageRst) End If If (Not IsMissing(varImage)) And (Len(Nz(IMAGE)) = 0) Then IMAGE = varImage End If IMAGE = Nz(IMAGE, "Default") Set newnodx = twTree.Nodes.Add(nChild, tvwChild, strPrefix & rst(strIDField), strText, IMAGE) rst.FindNext strCriteria Loop FillChildren_End: On Error Resume Next Exit Sub FillChildren_Err: Select Case Err.Number Case 35601, 35603 'Image not found!!! IMAGE = "FlagDefault" Resume Case 35602 'key not unique!!! Set newnodx = twTree.Nodes(strPrefix & rst(strIDField)) Resume Next Case Else MsgBox "Error in FillChildren!!! " & Err.Number & Err.Description Stop Resume End Select End Sub باب النقاش مفتوح لأي تعليقات وتوضيحات وتحديثات للجميع .. الأداة حصرية وليس لها أي أساس في أي موقع أجنبي أو عربي ( فقط في أوفيسنا ) *ملاحظة :- الدعوة للنقاش لا تقتصر على من لديه خبرة في آكسيس فقط . أيضاً أخوتنا الأساتذة برتبة ( خبير ) الذين أشعر أنهم غير معنيين بالمشاركة بمواضيع أخوتهم الأساتذة في هذا المنتدى هم معنيين خصوصاً بالمشاركة وإبداء الرأي ، وأرجو ان لا تكون هذه العبارة في غير محلها 😎 . نحن نتكاتف هنا لنتشارك معرفتنا وعلمنا الذي علمنا إياه الله - ولا علم إلا علمه . لذا متأملاً منهم خصوصاً مشاركتنا أفكارهم . 💥 الإداة بواجهتين ( عربي - انجليزي ) والرسائل والردود حسب كل لغة Code Converter x64.zip85.95 kB · 8 downloads Code Converter x32.zip80.96 kB · 5 downloads طبعاً ، أتمنى ممن يرغب بتجربة الأداة بأول إصدار لها ، أن يزودني بالنتيجة التي قام بها على الكود ، بحيث :- ينشر في رده الكود الأصل ( الذي قام بتجربته ) ، والكود الناتج ( بعد تحويله من الأداة ) لتعم الفائدة ولمعرفة الأخطاء التي قد تحدث ( ولا شك أن الأداة تحتوي أخطاء كثيرة ، ولكن لإجراءاتكم بالإفادة ) . إن كان يملك الكود الصحيح والمنطقي ( الذي يعمل على النواتين ) ، فشاكراً له تزويدنا به للمقارنة . Code Converter x32.zip80.96 kB · 5 downloads Code Converter x64.zip85.95 kB · 8 downloads

إحدى النكاشات الفكرية التي تدور في رأسي ، على سبيل المثال :- 1. التعامل مع الحمل المتعدد 😅 الولادة تكون أبكر عادة ، فمثلاً:- المعدل الطبيعي للولادة في التوائم = التوأم الثنائي : بين الأسبوع 36–37 التوأم الثلاثي : غالبًا قبل الأسبوع 34 لذا ، ومن وجهة نظري بحكم دراستي للتمريض ، لا يستخدم الأسبوع 40 كموعد قياسي لتقدير الوزن أو الطول . 2. التعامل مع سكري الحمل 😁 دول نقطتين خطروا في بالي ، قلت أسمعهم للهندسة 🤗 . لا أقصد بناءً مشروع كامل ، ولكن تمرين لأصابع ايدك التانية 😇 .

فعلاً ،، أصبت في هذا ، وانا لست معتاداً على هذا السكون 😅 . أما بالنسبة للتكة ، فـ دي حكايتها حكاااااية 🤣 أما بالنسبة للأستاذ @ابو جودي فألف سلامة عليك ، يعاني من كسر في يده اليمنى 🥺، ونتمنى له الشفاء العاجل يارب العالمين. ( يا رب ما كونش فتنت 😇 )

من باب النكاش لا النقاش الى ماذا استندت في :- ' حساب وزن الجنين المتوقع (بناءً على معادلة تقريبية) Select Case Weeks Case 8 To 12 EstimatedWeight = 1 + (Weeks - 8) * 6 ' نمو سريع في الثلث الأول (1-25 جم) Case 13 To 20 EstimatedWeight = 25 + (Weeks - 13) * 40 ' نمو في الثلث الثاني (25-300 جم) Case 21 To 30 EstimatedWeight = 300 + (Weeks - 21) * 80 ' زيادة مطردة (300-1100 جم) Case 31 To 40 EstimatedWeight = 1100 + (Weeks - 31) * 200 ' نمو كبير في الثلث الثالث (1100-3500 جم) Case Else EstimatedWeight = 3500 ' الحد الأقصى التقريبي عند الولادة End Select Me.txtEstimatedWeight = Format(EstimatedWeight, "0") & " جرام" ' حساب طول الجنين المتوقع (بالسنتيمتر) Select Case Weeks Case 8 To 12 EstimatedLength = 2 + (Weeks - 8) * 1.5 ' نمو سريع (2-8 سم) Case 13 To 20 EstimatedLength = 8 + (Weeks - 13) * 2 ' نمو مطرد (8-22 سم) Case 21 To 30 EstimatedLength = 22 + (Weeks - 21) * 2.5 ' زيادة في الطول (22-45 سم) Case 31 To 40 EstimatedLength = 45 + (Weeks - 31) * 0.5 ' نمو بطيء (45-50 سم) Case Else EstimatedLength = 50 ' الحد الأقصى التقريبي عند الولادة End Select Me.txtEstimatedLength = Format(EstimatedLength, "0.0") & " سم" حيث أن هذه المعادلات ليست دقيقة طبياً ، لأن وزن وطول الجنين يعتمدان على عوامل وراثية ، تغذوية ، وصحية للأم . في التطبيقات الطبية الحقيقية ، يتم الاعتماد على جداول معتمدة (مثل منحنيات WHO) أو قياسات السونار .

عمل جميل .. ويعطي معلومات مفيدة أيضاً .. وعجبتني فكرة الشهر القمري تقريباً ، في الجملة :- Months = GestationalAge / 30.42

جزااكم الله خيراً ، فعلاً تم تشغيل البرنامج بعد تسجيل الملف ، وللفائدة بطريقة التسجيل :- افتح CMD موجه الأوامر كمسؤول ، تأكد من نسخ الملف المرفق "MSSTDFMT.DLL" في مشاركة معلمي أبو خليل الى المسار :- C:\Windows\SysWOW64 اذا كان الويندوز 64 . ثم اكتب الأمر التالي للتسجيل :- regsvr32 "C:\Windows\SysWOW64\MSSTDFMT.DLL" حتى تحصل على النتيجة التالية : صورة البرنامج :- أجدت فيما طرحت ، وأبدعت معلمي الفاضل

زاد الله فضلك ، وأشكرك اهتمامك معلمي الفاضل ، ولكن للأسف لم تكتمل اللحظة 😥

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

وعليكم السلام ورحمة الله وبركاته ,, بعد فهم الموضوع ، هذه محاولتي البسيطة ، حيث بعد انشاء النموذج والتقرير ، وإضافة عنصر CheckBox جنب كل حقل ترغب بلإظهاره أو لا ، ومن خلال الزر في النموذج اعتمدت على TempVars لحفظ قيمة كل CheckBox ثم فتح التقرير من خلال الكود التالي في الزر :- Private Sub btn_PreviewReport_Click() TempVars("SelectedEmpCode") = Me.Tx_Emp.Column(0) TempVars("Show_NationalID") = Me.chk_NationalID.Value TempVars("Show_Emp_BirthDate") = Me.chk_Emp_BirthDate.Value TempVars("Show_Emp_Phone") = Me.chk_Emp_Phone.Value TempVars("Show_Qualification") = Me.chk_Qualification.Value TempVars("Show_Graduation") = Me.chk_Graduation.Value TempVars("Show_Emp_Address") = Me.chk_Emp_Address.Value TempVars("Show_Appointment") = Me.chk_Appointment.Value TempVars("Show_InsuranceID") = Me.chk_InsuranceID.Value TempVars("Show_JobDesc") = Me.chk_JobDesc.Value TempVars("Show_Department") = Me.chk_Department.Value TempVars("Show_Salary") = Me.chk_Salary.Value TempVars("Show_InsuranceFee") = Me.chk_InsuranceFee.Value DoCmd.OpenReport "Rpt_EmployeeStatement", acViewPreview End Sub الآن وفي التقرير ، استخدمت الـ Tag لتحديد ارتفاع العناصر جميعها بحيث تم تحديده 400 ، ومن هنا تم الاعتماد على الدالة :- Private Sub AdjustFieldVisibility(ctrl As Control, showField As Boolean) If showField Then ctrl.Height = Val(ctrl.Tag) ctrl.Visible = True Else ctrl.Visible = False ctrl.Height = 0 End If End Sub بإخفاء وتصغير ارتفاع العناصر التي لا نرغب بها .. وفي مصدر سجلات التقرير ، استخدم الاستعلام التالي :- SELECT * FROM tbl_Employees WHERE (((tbl_Employees.[Emp_Code])=[TempVars]![SelectedEmpCode])); وفي الحدث عند التنسيق ، استخدمت الكود التالي لاستدعاء الدالة السابقة وتطبيق الاخفاء على العناصر التي لا نريدها . Private Sub Detail_Format(Cancel As Integer, FormatCount As Integer) AdjustFieldVisibility Me.NationalID, TempVars!Show_NationalID AdjustFieldVisibility Me.Emp_BirthDate, TempVars!Show_Emp_BirthDate AdjustFieldVisibility Me.Emp_Phone, TempVars!Show_Emp_Phone AdjustFieldVisibility Me.Qualification, TempVars!Show_Qualification AdjustFieldVisibility Me.Graduation, TempVars!Show_Graduation AdjustFieldVisibility Me.Emp_Address, TempVars!Show_Emp_Address AdjustFieldVisibility Me.Appointment, TempVars!Show_Appointment AdjustFieldVisibility Me.InsuranceID, TempVars!Show_InsuranceID AdjustFieldVisibility Me.JobDesc, TempVars!Show_JobDesc AdjustFieldVisibility Me.Department, TempVars!Show_Department AdjustFieldVisibility Me.Salary, TempVars!Show_Salary AdjustFieldVisibility Me.InsuranceFee, TempVars!Show_InsuranceFee End Sub طبعاً طرق كثيرة قد تحقق لك المطلوب ، ولكن هذه رؤيتي وفي النهاية ، الملف بعد التعديل :- بيان حاله.accdb

جزاك الله عنا كل الخير .. انا اعجبتني الفكرة ، وقد تكون إضافة مميزة لبرنامج عيادات نسائية

وعليكم السلام ورحمة الله وبركاته ،، أكثر الله من هداياكم وعطاياكم معلمنا الفاضل .. وجزاكم الله كل الخير يبدو أنني لست من المحظوظين لأن النسخة 32 ، وانا عندي الإصدار 2016 - 64 😥

أحسنتم أخي الأستاذ @محمد هشام. ، ما تفضلتم به صحيح ولا شك فيه ، خصوصاً أن الدوال التي ذكرتها تعود بقيمة رقمية يتم تحويل التاريخ أو الوقت فيها الى رقم يفهمه اكسل أو آكسيس ، مما سيضطرني كمستخدم لتحويل تنسيق الخلية الى نوع تاريخ ( على سبيل المثال ) ليتم اظهار القيمة الرقمية على شكل تاريخ .. وعلى سبيل المثال ، قمت بتجربة بسيطة للتحقق مما اذا كان الناتج من فكرتي يتم قراءته كتاريخ أم لا ، باستخدام المعادلة :- = DATEDIF(M2, TODAY(), "y") & " سنوات و " & DATEDIF(M2, TODAY(), "ym") & " أشهر و " & DATEDIF(M2, TODAY(), "md") & " أيام" وطبعاً هي لكسب المعلومة ليس أكثر ( ) ، فقد كانت النتيجة صحيحة عند التعامل مع القيمة كقيمة تاريخ ، ( شريطة انني لم أغير تنسيق الخلية الى تاريخ ) .. ولكن ما تفضلتم به يثري معلوماتي في أكسل . فشكراً لكم أخي الفاضل رحابة صدركم ، وشرحكم الجميل

وعليكم السلام ورحمة الله وبركاته ., أخي الكريم ، تستطيع فعل هذا باستخدام الجملة التالية :- =TEXT(L2, "mmm dd, yyyy") وهذا مرفق لكيفية استخدامها وتنفيذها على جميع الخلايا التي تريدها .. تمديد.xlsx

في التحديث الجديد ، تم إضافة ميزات جديدة . بحيث :- تم دعم الحقول المدمجة في جوجل شيت . تم إضافة ميزة التحكم بتحديد صف العناوين ( للأوراق التي تدعم ترويسة ) في جوجل شيت . إصلاح بعض الأفكار السابقة للتعامل بشكل أسهل وأسرع عند الإستيراد من جوجل شيت . * ملاحظة :- لا ننصح باستخدام تسميات عربية للأوراق في جوجل شيت ( بسبب تغير سياسة جوجل شيت المتنقلة بين فترة وأخرى في إعدادات الـ API ) Excel Importor V3.0.accdb

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

وعليكم السلام ورحمة الله تعالى وبركاته.. الق نظرة على هذا الموضوع

عمل جميل ورائع ، ويعبر عن روعة صاحبه وأفكاره معلمنا الفاضل @jjafferr 😇 لم أقرأ هذا الموضوع سابقاً ، وأعتقد أن اليوم كان من حسن حظي اني تابعته

أخي @jo_2010 ، لاحظ أننا في الحلول التي قدمناها لك لم نعتمد على الصورة التي قمت بإضافتها الى الملف المرفق ، بل اعتمدنا على عنصر صورة واحد ومربع نص واحد = مصدر لعنصر الصورة بحيث في جملة شرطية مركبة ، اذا كانت قيمة مربع النص = "المختبر" يصبح مسار الصورة في عنصر الصورة = الصورة M.Png الموجودة داخل المجلد Images الموجود بجانب قاعدة البيانات . وإذا لم يتحقق الشرط يصبح مصدره الصورة BB.Png في نفس المسار والمجلد . وإلا كشرط ثالث اذا كانت القيمة فارغة = Null يصبح مصدر عنصر الصورة = الصورة الغير موجودة باسم Foksh افتراضاً .

في الملف الذي ارسلته لك ؟؟؟؟

Private Sub LABO_Click() DoCmd.RunSQL "UPDATE Tbl_Lab_All SET External_lab = Null " & _ "WHERE PCode = [ID];" Me.Refresh Me.Code_Kind.SetFocus End Sub