كل الانشطه

السلام عليكم هذا بحث بقلم الاستاذ الكريم عارف حسان وتجميع وتنسيق بالوورد من الاستاذ الكريم يوسف احمد اسال الله ان يكون عملا مباركا وعلما ينتفع به لهما ان شاء الله OOP.docx

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

جرب هدا Sub ConvertDates() Dim WS As Worksheet, lastRow As Long, i As Long Application.ScreenUpdating = False Set WS = ActiveSheet lastRow = WS.Cells(WS.Rows.Count, "L").End(xlUp).Row For i = 2 To lastRow If IsDate(WS.Cells(i, "L").Value) Then WS.Cells(i, "M").Value = DateValue(WS.Cells(i, "L").Value) WS.Cells(i, "M").NumberFormat = "mmm dd, yyyy" Else WS.Cells(i, "M").Value = "" End If Next i Application.ScreenUpdating = True End Sub

في اللغة العربية، لا يمكن وضع ثلاث حركات (الفتحة، الضمة، الكسرة) على حرف واحد في نفس الوقت. كل حركة من هذه الحركات تدل على صوت مختلف للحرف، وبالتالي لا يمكن أن ينطق الحرف بثلاثة أصوات مختلفة في نفس اللحظة. ما قد يقصد بالسؤال: الجمع بين الحركة والشدة: قد يلتبس الأمر على البعض بين الحركات الأساسية والشدة. الشدة (ـّ) توضع فوق الحرف لتضعيف لفظه (أي كأنه مكتوب مرتين)، ويمكن أن يصاحبها حركة (فتحة، ضمة، كسرة). فمثلاً، "مُحَمَّد" (الميم مضمومة، الحاء مفتوحة، الميم مشددة ومفتوحة). هنا، الحرف المشدد يحمل حركة (الفتحة في هذه الحالة)، لكن الشدة نفسها ليست حركة إعرابية بل علامة تضعيف. المدود والحركات: حروف المد (الألف، الواو، الياء) هي في الأصل حركات طويلة (الفتحة الطويلة، الضمة الطويلة، الكسرة الطويلة). فمثلاً، الألف الممدودة (آ) هي اجتماع همزتين، الأولى مفتوحة والثانية ساكنة، وتُلفظ ألفاً ممدودة. لكن هذا لا يعني وضع ثلاث حركات على حرف واحد. مثلثات قطرب: هذه ظاهرة لغوية نادرة وليست قاعدة عامة، حيث تتغير دلالة الكلمة بتغيير حركة حرف واحد فيها، مثل: "الغَمْرُ" (الماء الكثير) و"الغِمْرُ" (الحقد) و"الغُمْرُ" (الرجل الذي لم يجرب الأمور). لكن هنا، يتم تغيير الحركة في كل كلمة على حدة، وليس وضع الحركات الثلاث على نفس الحرف في نفس الكلمة. الخلاصة: لا يوجد خط أو طريقة في اللغة العربية تسمح بوضع ثلاث حركات (فتحة وكسرة وضمة) على حرف واحد في نفس الوقت. كل حركة من هذه الحركات تدل على صوت محدد للحرف.

وعليكم السلام ورحمة الله تعالى وبركاته اخي @AMIRBM 1) الأفضل هو تجاهل الصفوف الفارغة في عمود G بدلا من تقييد العرض بـ 51 صف فقط لأنك بذلك تمنع عرض أي بيانات جديدة تضاف لاحقا بعد الصف 51 أي إدخال جديد لن يظهر في الـ ListBox الكود يصبح محدودا وغير ديناميكي 2) بعد معاينة الملف لاحظت انك اسم الجدول على ورقة العمل باسم Tableau5 بينما الكود يشير إلى Tableau1 وهذا سيؤدي حتما إلى ظهور خطأ عند التشغيل لأن الكود يبحث عن جدول غير موجود وهده النقطة يمكننا تجاوزها إدا فهمنا ما تحاول فعله بالاعتماد على نطاق البيانات مباشرة من الورقة دون الحاجة لاستخدام جدول محدد أو إسمه مما يجعل الكود أكثر مرونة ولا يتأثر بتغيير الأسماء أو حذف الجداول وكدالك عرض كل الصفوف التي تحتوي على بيانات فعلية فقط مهما كان عددها 3) إذا كنت متأكد أن تقييد العرض على 51 صف فقط هو المطلوب ويراعي ظروف عملك يمكننا تعديل الكود ليقوم بعرض أول 51 صف من البيانات الفعلية فقط في النهاية الأمر يعود لاختيارك حسب متطلباتك هل ترغب أن أعدل لك الكود بحيث يعرض فقط أول 51 صف غير فارغ في العمود G ؟ أو تفضل التعديل الديناميكي الذي يعرض كل الصفوف الفعلية ويتجاهل الفراغات ؟

مشكورين جميعكم ولاكني جربت كل المحاولات لم تزبط معي للاسف يطلع لي #VALUE! هل ممكن عن طرق كود ممكن يزبط معي

تفضل التقرير حسب ماطلبت مع العلم هذا أخر مالديا بالنسبة للجدول لأني ما أقدر أعيد برمجة البرنامج ككل . تمنيلاي لك بالتوفيق . DDFinding Differences-FINAL_8.rar

خط حلمي محمود لرموز الرياضيات

بالتأكيد، هذه مشكلة شائعة عند دمج المراسلات من Excel إلى Word، وتحدث لأن Word لا يتعرف تلقائيًا على تنسيق التاريخ الصحيح من Excel في بعض الأحيان، ويعامله على أنه رقم تسلسلي (وهو كيفية تخزين التواريخ داخليًا في Excel). إليك خطوات لحل هذه المشكلة: الطريقة الأولى: استخدام محولات الحقول (Field Switches) في Word (الأكثر شيوعًا وفعالية) أكمل عملية دمج المراسلات: قم بدمج المراسلات كالمعتاد حتى تظهر التواريخ كأرقام في مستند Word المدمج. حدد حقل التاريخ في Word: في مستند Word المدمج، حدد الرقم الذي يمثل التاريخ (مثل 44321). اضغط على Shift + F9: هذا سيحول الحقل من عرضه العادي إلى عرضه الكودي (مثل { MERGEFIELD "تاريخ_الميلاد" }). أضف محول التنسيق (Date-Time Picture Switch): داخل الأقواس المعقوفة، بعد اسم الحقل، أضف محول تنسيق التاريخ. يكون بالشكل التالي: للتاريخ الكامل (يوم/شهر/سنة): \@ "dd/MM/yyyy" لليوم والشهر فقط: \@ "dd MMMM" للتاريخ مع اسم الشهر (مثلاً: 25 مايو 2024): \@ "dd MMMM yyyy" مثال: إذا كان الحقل هو { MERGEFIELD "تاريخ_الميلاد" }، فبعد التعديل سيصبح: { MERGEFIELD "تاريخ_الميلاد" \@ "dd/MM/yyyy" } أو { MERGEFIELD "تاريخ_الميلاد" \@ "dd MMMM yyyy" } ملاحظة: تأكد من أن هناك مسافة واحدة بين اسم الحقل و\@. اضغط على F9: بعد إضافة المحول، اضغط على F9 (أو Fn + F9 على بعض لوحات المفاتيح) لتحديث الحقل. سيتم الآن عرض التاريخ بالشكل الصحيح. كرر العملية لكل حقول التاريخ: ستحتاج إلى تكرار هذه العملية لكل حقول التاريخ التي تظهر بشكل غير صحيح. حفظ التغييرات في المستند الرئيسي (Master Document): إذا كنت تريد تطبيق هذا التغيير على جميع عمليات الدمج المستقبلية، قم بإجراء هذه التعديلات في مستند دمج المراسلات الرئيسي (قالب Word) قبل حفظه. الطريقة الثانية: تغيير تنسيق الخلايا في Excel (أقل شيوعًا في حل هذه المشكلة بالتحديد) على الرغم من أنك ذكرت أن التواريخ مكتوبة بشكل صحيح في Excel، إلا أنه في بعض الأحيان يمكن أن يساعد إعادة التأكد من تنسيق الخلايا في Excel: افتح ملف Excel: افتح ملف Excel الذي تستخدمه كمصدر للبيانات. حدد عمود التاريخ: حدد العمود الذي يحتوي على التواريخ. انقر بزر الماوس الأيمن: اختر "تنسيق الخلايا" (Format Cells). اختر "تاريخ" (Date): تأكد من أن الفئة محددة على "تاريخ" (Date) واختر التنسيق المطلوب (مثل 14/3/2012 أو 14 آذار 2012). تأكد من نوع البيانات: في بعض الأحيان، قد تكون البيانات مكتوبة كنص على الرغم من أنها تبدو كتواريخ. لتجنب ذلك، حاول إدخال تاريخ جديد في خلية فارغة بالعمود الذي تريد تنسيقه، ثم اسحب مقبض التعبئة (Fill Handle) لأسفل لتطبيقه على باقي الخلايا، أو استخدم "نص إلى أعمدة" (Text to Columns) لتحويلها. احفظ ملف Excel: احفظ التغييرات في ملف Excel. أعد دمج المراسلات في Word: أعد تشغيل عملية دمج المراسلات في Word. نصائح إضافية: تجنب نسخ التواريخ ولصقها كنصوص: إذا كنت تقوم بنسخ التواريخ من مكان آخر، تأكد من لصقها كقيم أو كتواريخ، وليس كنصوص. اختبار على مجموعة صغيرة: قبل دمج مستند كبير، اختبر التغييرات على مستند دمج مراسلات صغير يحتوي على بضعة سجلات فقط. إعادة توصيل مصدر البيانات: في بعض الأحيان، قد يساعد فصل مصدر البيانات عن مستند Word وإعادة توصيله مرة أخرى. (من تبويب "المراسلات" -> "تحديد المستلمين" -> "استخدام قائمة موجودة" ثم إعادة تحديد ملف Excel). الخلاصة: الطريقة الأولى (باستخدام محولات الحقول \@ "dd/MM/yyyy") هي الأكثر فعالية والأسهل لتصحيح تنسيق التواريخ في دمج المراسلات. آمل أن يساعدك هذا الحل

وعليكم السلام ورحمة الله وبركاته اشارك برأي من باب المشاركة ولست خبيرا ,,,,, لأنك انت من طلب من غير الخبراء المشاركة 😃 عن تعديل الكود اعتقد يجب النظر في كل المتغيرات والدوال مثلا هناك دوال تحتاج الى تعديل للعمل في بيئة 64 bit مثل ::::::::::::::: 1. FindWindow 2. GetWindowLong / SetWindowLong 3. GetTickCount 4. ShellExecute 5. Sleep 6. GetSystemMetrics 7. GetCursorPos 8. OpenProcess 9. CreateFile والله اعلم

السلام عليكم ورحمة الله وبركاته ،، في طور تحسين الأداة الجديدة ( لم يعلن عنها بعد ) ، للتعامل مع الأكواد التي تعمل على 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 باب النقاش مفتوح لأي تعليقات وتوضيحات وتحديثات للجميع .. الأداة حصرية وليس لها أي أساس في أي موقع أجنبي أو عربي ( فقط في أوفيسنا ) *ملاحظة :- الدعوة للنقاش لا تقتصر على من لديه خبرة في آكسيس فقط . أيضاً أخوتنا الأساتذة برتبة ( خبير ) الذين أشعر أنهم غير معنيين بالمشاركة بمواضيع أخوتهم الأساتذة في هذا المنتدى هم معنيين خصوصاً بالمشاركة وإبداء الرأي ، وأرجو ان لا تكون هذه العبارة في غير محلها 😎 . نحن نتكاتف هنا لنتشارك معرفتنا وعلمنا الذي علمنا إياه الله - ولا علم إلا علمه . لذا متأملاً منهم خصوصاً مشاركتنا أفكارهم .

فعلاً انا لاحظت تعليق انشاء موضوع جديد اتوقعت المشكلة من عندي لكن الحمد لله تم حل المشكلة وشكراً على الطرح يا معلمنا ابا خليل والشكر موصول للمهندسين Foksh - ابو جودي على إثرائهم للمواضيع بصفة عامة ... نفع الله بكم

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

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

بسم الله ما شاء الله عمل رائع جزاك الله كل خير

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

والرد من باب النكاش وبعيدا عن اى نقاش لان خلاص فاضل تكــه هذه الحسابات تستند إلى نمو الجنين الطبيعي خلال مراحل الحمل وفقا لدراسات طبية وملاحظات حول كيفية تطور الجنين في الرحم في كل أسبوع من أسابيع الحمل هذه الحسابات الدراسية طبعا انت يا فؤش أفندى لازم تصحى الوحش اللى جوايا يعنى الله يسامحك بقالى ساعه اكتب وصوابعى وجعتنى وانت عارف ليه طيب بعد البحث لو اردنا نتائج اكثر دقة وبالاستناد الى هذا الموقع المتخصص https://www.babycenter.com/pregnancy/your-body/growth-chart-fetal-length-and-weight-week-by-week_1290794 هيكون ده شكل الكود النهائى اللى قبل التكه علشان خلاص Option Compare Database Option Explicit ' ثابت لتوحيد تنسيق التاريخ باستخدام نمط ISO (YYYY-MM-DD) Private Const IsoDateFormat As String = "yyyy-mm-dd" ' تعريف Enum للثلث الحملي Public Enum EnmTrimester First = 1 Second = 2 Third = 3 End Enum ' ================================ ' دوال مساعدة ' ================================ ' دالة للاستيفاء الخطي مع حماية ضد القسمة على صفر Private Function LinearInterpolate(ByVal x As Double, ByVal x1 As Double, ByVal x2 As Double, ByVal y1 As Double, ByVal y2 As Double) As Double If x2 - x1 = 0 Then LinearInterpolate = y1 ' إرجاع y1 إذا كان الفاصل صفرًا Else LinearInterpolate = y1 + (y2 - y1) * (x - x1) / (x2 - x1) End If End Function ' دالة لتحويل الثلث الحملي إلى نص عربي Private Function TrimesterToString(ByVal trimester As EnmTrimester) As String Select Case trimester Case EnmTrimester.First: TrimesterToString = "الثلث الأول" Case EnmTrimester.Second: TrimesterToString = "الثلث الثاني" Case EnmTrimester.Third: TrimesterToString = "الثلث الثالث" End Select End Function ' دالة لحساب تاريخ الولادة المتوقع (EDD) Private Function GetEDD(ByVal LMP As Date, ByVal CycleLength As Integer, ByVal IsMultiplePregnancy As Boolean) As Date If IsMultiplePregnancy Then GetEDD = DateAdd("d", 266 + (CycleLength - 28), LMP) Else GetEDD = DateAdd("d", 280 + (CycleLength - 28), LMP) End If End Function ' دالة لحساب تاريخ التبويض Private Function GetOvulationDate(ByVal LMP As Date, ByVal CycleLength As Integer) As Date GetOvulationDate = DateAdd("d", CycleLength \ 2, LMP) End Function ' دالة لتحديد الثلث الحملي Private Function GetTrimester(ByVal Weeks As Long) As EnmTrimester Select Case Weeks Case 0 To 13: GetTrimester = EnmTrimester.First Case 14 To 26: GetTrimester = EnmTrimester.Second Case Else: GetTrimester = EnmTrimester.Third End Select End Function ' دوال تنسيق Private Function FormatDate(ByVal d As Date) As String FormatDate = Format(d, IsoDateFormat) End Function Private Function FormatWeeksDays(ByVal Weeks As Long, ByVal Days As Long) As String FormatWeeksDays = Weeks & " أسابيع و " & Days & " أيام" End Function Private Function FormatMonthsDays(ByVal Months As Double, ByVal Days As Long) As String FormatMonthsDays = Format(Months, "0") & " شهور و " & Days & " أيام" End Function Private Function FormatDays(ByVal Days As Long) As String FormatDays = Days & " أيام" End Function ' دالة لتوليد رسائل تحذير مخصصة Private Function GetWarningMessage(ByVal Context As String, ByVal Weeks As Long, ByVal trimester As EnmTrimester) As String Select Case Context Case "PostTerm" GetWarningMessage = "عمر الحمل تجاوز 42 أسبوعًا. يُنصح بالمتابعة الفورية مع أخصائي النساء والتوليد لتقييم الوضع واتخاذ القرار المناسب." Case "InvalidLMP" GetWarningMessage = "تاريخ آخر دورة شهرية يجب أن يكون قبل التاريخ الحالي. يرجى تصحيح الإدخال." Case "InvalidCycleLength" GetWarningMessage = "طول الدورة الشهرية يجب أن يكون بين 21 و35 يومًا. سيتم استخدام القيمة الافتراضية (28 يومًا)." Case "EarlyPregnancy" GetWarningMessage = "الحمل في مرحلة مبكرة جدًا (أقل من 4 أسابيع). يُنصح بزيارة الطبيب لتأكيد الحمل." Case "InvalidInput" GetWarningMessage = "المدخلات غير صالحة. يرجى التأكد من إدخال تاريخ وطول دورة شهرية صحيحين." Case Else GetWarningMessage = "يرجى مراجعة الطبيب لتقييم حالة الحمل في " & TrimesterToString(trimester) & "." End Select End Function ' دالة للتحقق من صحة المدخلات Private Function ValidateInputs(ByVal LMP As Variant, ByVal CycleLength As Variant, ByVal Today As Date) As String If IsNull(LMP) Or Not IsDate(LMP) Then ValidateInputs = "InvalidInput" ElseIf LMP > Today Then ValidateInputs = "InvalidLMP" ElseIf Not IsNumeric(CycleLength) Or CycleLength < 21 Or CycleLength > 35 Then ValidateInputs = "InvalidCycleLength" Else ValidateInputs = "" End If End Function ' ================================ ' دوال تقدير وزن وطول الجنين ' ================================ Public Function EstimatedWeight(ByVal Weeks As Integer, Optional ByVal IsMultiplePregnancy As Boolean = False) As Variant Dim WeeksArray, WeightArray WeeksArray = Array(4, 6, 8, 12, 16, 20, 24, 28, 32, 36, 40, 42) WeightArray = Array(1, 10, 20, 58, 190, 331, 660, 1176, 1900, 2800, 3619, 3800) If Weeks > 42 Then EstimatedWeight = Array(WeightArray(UBound(WeightArray)), True) Exit Function End If Dim i As Integer For i = 0 To UBound(WeeksArray) - 1 If Weeks >= WeeksArray(i) And Weeks <= WeeksArray(i + 1) Then Dim weight As Double weight = LinearInterpolate(Weeks, WeeksArray(i), WeeksArray(i + 1), WeightArray(i), WeightArray(i + 1)) If IsMultiplePregnancy Then weight = weight * 0.85 EstimatedWeight = Array(weight, False) Exit Function End If Next i If Weeks < WeeksArray(0) Then EstimatedWeight = Array(WeightArray(0), False) Else EstimatedWeight = Array(WeightArray(UBound(WeightArray)), False) End If End Function Public Function EstimatedLength(ByVal Weeks As Integer, Optional ByVal IsMultiplePregnancy As Boolean = False) As Variant Dim WeeksArray, LengthArray WeeksArray = Array(4, 6, 8, 12, 16, 20, 24, 28, 32, 36, 40, 42) LengthArray = Array(0.2, 0.8, 1.57, 5.4, 11.6, 25.7, 33, 38.6, 44, 48, 51, 52) If Weeks > 42 Then EstimatedLength = Array(LengthArray(UBound(LengthArray)), True) Exit Function End If Dim i As Integer For i = 0 To UBound(WeeksArray) - 1 If Weeks >= WeeksArray(i) And Weeks <= WeeksArray(i + 1) Then Dim length As Double length = LinearInterpolate(Weeks, WeeksArray(i), WeeksArray(i + 1), LengthArray(i), LengthArray(i + 1)) If IsMultiplePregnancy Then length = length * 0.85 EstimatedLength = Array(length, False) Exit Function End If Next i If Weeks < WeeksArray(0) Then EstimatedLength = Array(LengthArray(0), False) Else EstimatedLength = Array(LengthArray(UBound(LengthArray)), False) End If End Function ' ================================ ' دالة حساب شهر الحمل ' ================================ Public Function GetPregnancyMonth(ByVal Weeks As Long) As Variant Select Case Weeks Case 0 To 4: GetPregnancyMonth = Array(1, False) Case 5 To 8: GetPregnancyMonth = Array(2, False) Case 9 To 13: GetPregnancyMonth = Array(3, False) Case 14 To 17: GetPregnancyMonth = Array(4, False) Case 18 To 21: GetPregnancyMonth = Array(5, False) Case 22 To 26: GetPregnancyMonth = Array(6, False) Case 27 To 30: GetPregnancyMonth = Array(7, False) Case 31 To 35: GetPregnancyMonth = Array(8, False) Case 36 To 42: GetPregnancyMonth = Array(9, False) Case Else: GetPregnancyMonth = Array(9, True) End Select End Function ' ================================ ' دالة التوصيات الطبية ' ================================ Public Function GetMedicalCheckup(ByVal Weeks As Long) As String Select Case Weeks Case 4 To 5 GetMedicalCheckup = "زيارة مبكرة لتأكيد الحمل." Case 6 To 8 GetMedicalCheckup = "زيارة تأكيد الحمل وفحص مبكر بالموجات فوق الصوتية." Case 10 To 13 GetMedicalCheckup = "فحص الشفافية القفوية (NT Scan) وفحص الدم الأولي." Case 16 GetMedicalCheckup = "فحص الدم للكشف عن التشوهات الجينية (Triple/Quad Screen)." Case 20 GetMedicalCheckup = "فحص السونار التشريحي لتقييم نمو الجنين." Case 24 To 28 GetMedicalCheckup = "فحص السكري في الحمل (Glucose Tolerance Test)." Case 32 GetMedicalCheckup = "فحص نمو الجنين بالموجات فوق الصوتية." Case 35 To 37 GetMedicalCheckup = "فحص بكتيريا العقدية (Group B Streptococcus - GBS)." Case 38 To 40 GetMedicalCheckup = "فحوصات أسبوعية لمراقبة الجنين والأم." Case 41 To 42 GetMedicalCheckup = "مراقبة الحمل المتأخر، قد يتطلب تحفيز الولادة." Case Is > 42 GetMedicalCheckup = "الحمل تجاوز 42 أسبوعًا. يُنصح بالمتابعة الفورية مع أخصائي النساء والتوليد." Case Else GetMedicalCheckup = "متابعة الفحوصات الدورية مع الطبيب." End Select End Function ' دالة لتحديد النصائح Private Function GetPregnancyTips(ByVal trimester As EnmTrimester, ByVal IsMultiplePregnancy As Boolean) As String Dim GeneralTips As String, NutritionTips As String, ExerciseTips As String Select Case trimester Case EnmTrimester.First GeneralTips = "تجنب الأطعمة النيئة، ومراجعة الطبيب." NutritionTips = "تناول أطعمة غنية بحمض الفوليك (مثل السبانخ والعدس) وفيتامين B6 لتقليل الغثيان." ExerciseTips = "مارسي المشي الخفيف (20-30 دقيقة يوميًا) وتمارين التنفس لتخفيف التوتر." Case EnmTrimester.Second GeneralTips = "حركة الجنين تبدأ، والتغذية مهمة." NutritionTips = "زيدي السعرات بحوالي 300 سعرة يوميًا، ركزي على البروتين (مثل الدجاج والبقوليات) وأوميغا-3 (مثل السلمون)." ExerciseTips = "جربي اليوغا الخاصة بالحمل، تمارين تقوية الحوض (مثل Kegel)، أو السباحة الخفيفة." Case EnmTrimester.Third GeneralTips = "الاستعداد للولادة، وزيادة الوزن." NutritionTips = "تناولي أطعمة غنية بالحديد (مثل السبانخ والكبد) والكالسيوم (مثل الحليب والزبادي)، واشربي كميات كافية من الماء." ExerciseTips = "مارسي تمارين الإطالة لتحسين وضعية الجسم، المشي البطيء، وتمارين التنفس للتحضير للولادة." End Select GetPregnancyTips = GeneralTips & vbCrLf & "التغذية: " & NutritionTips & vbCrLf & "التمارين: " & ExerciseTips If IsMultiplePregnancy Then GetPregnancyTips = GetPregnancyTips & vbCrLf & "ملاحظة: الحمل المتعدد قد يتطلب متابعة طبية إضافية." End If End Function ' دالة لتوليد تقرير الحمل Private Function GeneratePregnancyReport(ByVal Results As Collection) As String Dim Report As String Report = "تقرير الحمل" & vbCrLf & String(30, "=") & vbCrLf Report = Report & "تاريخ آخر دورة شهرية: " & FormatDate(Results("LMP")) & vbCrLf Report = Report & "التاريخ الحالي: " & FormatDate(Results("Today")) & vbCrLf Report = Report & "مدة الحمل الحالية: " & FormatWeeksDays(Results("Weeks"), Results("Days")) & vbCrLf Report = Report & "الشهر الحملي: الشهر " & Results("PregnancyMonth") & vbCrLf Report = Report & "الثلث الحملي: " & TrimesterToString(Results("Trimester")) & vbCrLf Report = Report & "تاريخ الولادة المتوقع: " & FormatDate(Results("EDD")) & vbCrLf Report = Report & "الوقت المتبقي: " & FormatWeeksDays(Results("RemainingWeeks"), Results("RemainingDaysMod")) & vbCrLf Report = Report & "وزن الجنين التقديري: " & Format(Results("Weight"), "0") & " جرام" & vbCrLf Report = Report & "طول الجنين التقديري: " & Format(Results("Length"), "0.0") & " سم" & vbCrLf Report = Report & "نصائح الحمل:" & vbCrLf & Results("Tips") & vbCrLf Report = Report & "التوصيات الطبية: " & Results("MedicalCheckup") & vbCrLf GeneratePregnancyReport = Report End Function ' ================================ ' دالة الحساب الرئيسية ' ================================ Public Function CalculatePregnancyInfo(ByVal LMP As Variant, ByVal CycleLength As Variant, ByVal IsMultiplePregnancy As Boolean, Optional ByVal Today As Date = 0) As Variant ' تعيين التاريخ الحالي إذا لم يُحدد If Today = 0 Then Today = Date ' التحقق من صحة المدخلات Dim ValidationResult As String ValidationResult = ValidateInputs(LMP, CycleLength, Today) If ValidationResult <> "" Then CalculatePregnancyInfo = Array(False, ValidationResult) Exit Function End If ' تحويل المدخلات إلى الأنواع الصحيحة Dim LMPDate As Date: LMPDate = CDate(LMP) Dim CycleLengthInt As Integer: CycleLengthInt = CInt(CycleLength) ' حسابات الحمل Dim GA_Days As Long: GA_Days = DateDiff("d", LMPDate, Today) Dim Weeks As Long: Weeks = GA_Days \ 7 Dim Days As Long: Days = GA_Days Mod 7 Dim GA_Months As Double: GA_Months = Weeks / 4.3 Dim EDD As Date: EDD = GetEDD(LMPDate, CycleLengthInt, IsMultiplePregnancy) Dim RemainingDays As Long: RemainingDays = DateDiff("d", Today, EDD) Dim RemainingWeeks As Long: RemainingWeeks = RemainingDays \ 7 Dim RemainingDaysMod As Long: RemainingDaysMod = RemainingDays Mod 7 Dim RemMonths As Double: RemMonths = RemainingWeeks / 4.3 Dim OvulationDate As Date: OvulationDate = GetOvulationDate(LMPDate, CycleLengthInt) ' حساب الوزن والطول Dim WeightResult As Variant: WeightResult = EstimatedWeight(Weeks, IsMultiplePregnancy) Dim TempWeight As Double: TempWeight = WeightResult(0) Dim LengthResult As Variant: LengthResult = EstimatedLength(Weeks, IsMultiplePregnancy) Dim TempLength As Double: TempLength = LengthResult(0) Dim MonthResult As Variant: MonthResult = GetPregnancyMonth(Weeks) Dim PregnancyMonth As Long: PregnancyMonth = MonthResult(0) ' تحديد الثلث الحملي Dim CurrentTrimester As EnmTrimester: CurrentTrimester = GetTrimester(Weeks) ' تحديد النصائح Dim Tips As String: Tips = GetPregnancyTips(CurrentTrimester, IsMultiplePregnancy) Dim MedicalCheckup As String: MedicalCheckup = GetMedicalCheckup(Weeks) ' التحقق من تجاوز 42 أسبوعًا أو الحمل المبكر Dim WarningMessage As String If WeightResult(1) Or LengthResult(1) Or MonthResult(1) Then WarningMessage = GetWarningMessage("PostTerm", Weeks, CurrentTrimester) ElseIf Weeks < 4 Then WarningMessage = GetWarningMessage("EarlyPregnancy", Weeks, CurrentTrimester) End If ' تجميع النتائج في Collection Dim Results As New Collection Results.Add LMPDate, "LMP" Results.Add Today, "Today" Results.Add CycleLengthInt, "CycleLength" Results.Add IsMultiplePregnancy, "IsMultiplePregnancy" Results.Add GA_Days, "TotalDays" Results.Add Weeks, "Weeks" Results.Add Days, "Days" Results.Add GA_Months, "GestationalMonths" Results.Add EDD, "EDD" Results.Add RemainingDays, "RemainingDays" Results.Add RemainingWeeks, "RemainingWeeks" Results.Add RemainingDaysMod, "RemainingDaysMod" Results.Add RemMonths, "RemainingMonths" Results.Add OvulationDate, "OvulationDate" Results.Add TempWeight, "Weight" Results.Add TempLength, "Length" Results.Add PregnancyMonth, "PregnancyMonth" Results.Add CurrentTrimester, "Trimester" Results.Add Tips, "Tips" Results.Add MedicalCheckup, "MedicalCheckup" CalculatePregnancyInfo = Array(True, Results, WarningMessage) End Function ' دالة لتحديث واجهة النموذج Private Sub UpdateForm(ByVal Results As Collection, ByVal WarningMessage As String) If WarningMessage <> "" Then MsgBox WarningMessage End If Me.txtCurrentDate = FormatDate(Results("Today")) Me.txtCurrentDate.ControlTipText = "التاريخ الحالي بناءً على تاريخ النظام (YYYY-MM-DD)" Me.txtCycleLength = Results("CycleLength") Me.txtCycleLength.ControlTipText = "طول الدورة الشهرية بالأيام (عادةً 21-35 يومًا)" Me.chkMultiplePregnancy = Results("IsMultiplePregnancy") Me.chkMultiplePregnancy.ControlTipText = "حدد إذا كان الحمل متعددًا (مثل التوائم)" Me.txtWeeks = Results("Weeks") Me.txtWeeks.ControlTipText = "عدد الأسابيع منذ بداية الحمل" Me.txtDays = Results("Days") Me.txtDays.ControlTipText = "الأيام المتبقية بعد الأسابيع الكاملة" Me.txtCurrentGestation = FormatMonthsDays(Results("GestationalMonths"), Results("Days")) Me.txtCurrentGestation.ControlTipText = "العمر الحملي الحالي بالشهور والأيام" Me.txtTrimester = TrimesterToString(Results("Trimester")) Me.txtTrimester.ControlTipText = "الثلث الحملي الحالي (الأول، الثاني، الثالث)" Me.txtPregnancyTips = Results("Tips") Me.txtPregnancyTips.ControlTipText = "نصائح طبية وغذائية ورياضية تتعلق بالمرحلة الحالية من الحمل" Me.txtMonth = "الشهر " & Results("PregnancyMonth") Me.txtMonth.ControlTipText = "الشهر التقريبي من الحمل بناءً على عدد الأسابيع" Me.txtOvulationDate = FormatDate(Results("OvulationDate")) Me.txtOvulationDate.ControlTipText = "تاريخ التبويض المحتمل بناءً على تاريخ الدورة الشهرية (YYYY-MM-DD)" Me.txtWeek = "الأسبوع " & Results("Weeks") Me.txtWeek.ControlTipText = "رقم الأسبوع الحالي من الحمل" Me.txtWeeksAndDays = FormatWeeksDays(Results("Weeks"), Results("Days")) Me.txtWeeksAndDays.ControlTipText = "مدة الحمل الحالية بأسابيع وأيام" Me.txtTotalDays = FormatDays(Results("TotalDays")) Me.txtTotalDays.ControlTipText = "إجمالي عدد أيام الحمل حتى الآن" Me.txtEstimatedWeight = Format(Results("Weight"), "0") & " جرام" Me.txtEstimatedWeight.ControlTipText = "الوزن التقديري للجنين حسب عدد الأسابيع" Me.txtEstimatedLength = Format(Results("Length"), "0.0") & " سم" Me.txtEstimatedLength.ControlTipText = "الطول التقديري للجنين حسب عدد الأسابيع" Me.txtExpectedDeliveryDate = FormatDate(Results("EDD")) Me.txtExpectedDeliveryDate.ControlTipText = "تاريخ الولادة المتوقع بناءً على التبويض (YYYY-MM-DD)" Me.txtRemainingTime = FormatMonthsDays(Results("RemainingMonths"), Results("RemainingDaysMod")) Me.txtRemainingTime.ControlTipText = "المدة المتبقية حتى موعد الولادة بالشهور والأيام" Me.txtRemainingWeeks = FormatWeeksDays(Results("RemainingWeeks"), Results("RemainingDaysMod")) Me.txtRemainingWeeks.ControlTipText = "المدة المتبقية حتى الولادة بالأسابيع والأيام" Me.txtRemainingDays = FormatDays(Results("RemainingDays")) Me.txtRemainingDays.ControlTipText = "عدد الأيام المتبقية حتى الولادة" Me.txtMedicalCheckup = Results("MedicalCheckup") Me.txtMedicalCheckup.ControlTipText = "توصيات طبية بناءً على أسبوع الحمل" End Sub ' حدث تحديث النموذج Private Sub UpdateFormFromInputs() Dim Result As Variant Result = CalculatePregnancyInfo(Me.txtLastMenstrualDate, Me.txtCycleLength, Nz(Me.chkMultiplePregnancy, False)) If Result(0) Then UpdateForm Result(1), Result(2) ' عرض التقرير (يمكن إضافته إلى زر أو حدث لاحقًا) Debug.Print GeneratePregnancyReport(Result(1)) Else MsgBox Result(1) End If End Sub ' ================================ ' أحداث النموذج ' ================================ Private Sub txtLastMenstrualDate_AfterUpdate() txtLastMenstrualDate = FormatDate(txtLastMenstrualDate) UpdateFormFromInputs End Sub Private Sub txtCycleLength_AfterUpdate() UpdateFormFromInputs End Sub Private Sub chkMultiplePregnancy_AfterUpdate() UpdateFormFromInputs End Sub Private Sub Form_Load() Me.txtCurrentDate = FormatDate(Date) Me.txtCurrentDate.ControlTipText = "التاريخ الحالي بناءً على تاريخ النظام (YYYY-MM-DD)" End Sub وأخيرا المرفق الغنى ExpectedDeliveryDate(4).accdb

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

تم اضافة جدول جديد (tbl_EmpInfo) جدول معلومات الموظفين الجدد وعمل نموذج لإدخال المعلومات . وذلك لعدم المساس بالجدولين (T1) و(T2) . لأنهم جداول العمليات وداخلين بالبرمجة . وتفضل الشرح والمرفق . DDFinding Differences-FINAL_7.rar تصبح على خير وباكر انشاء الله نكمل اذا كان في طلب جديد .

من باب النكاش لا النقاش الى ماذا استندت في :- ' حساب وزن الجنين المتوقع (بناءً على معادلة تقريبية) 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) أو قياسات السونار .

مشكور اخي العزيز اريد ان يكون جدول T1 يحمل معلومات موظف فقط حيث ان رقم الموظف لا يتكرر اما جدولT2 هو جدول تحدث فيه عمليات موظف وكل عملية لها رقم ملف FileNO

ما شاء الله .. كفيت ووفيت .. ثقافة طبية جميلة شاملة

تفضل التصحيح وجربته ويعمل تمام . DDFinding Differences-FINAL_6.rar

واذا حد مهتم فى الموضوع ويريد حسابات ومعلومات أكثر ان شاء الله هذا المرفق يكون كاف و واف وشامل يا استاذى الجليل و معلمى القدير و والدى الحبيب الاستاذ @ابوخليل ExpectedDeliveryDate(3).accdb

كلمة السر admin 1989 admin 1989