حساب تاريخ الحمل ، وموعد الولادة المقدر

[ابوخليل]

السلام عليكم

هدية طريفة .. وجدتها .. فاحببت ان اتحفكم بها

 

حساب الحمل.rar

[Foksh]

وعليكم السلام ورحمة الله وبركاته ،،

أكثر الله من هداياكم وعطاياكم معلمنا الفاضل .. وجزاكم الله كل الخير

 

يبدو أنني لست من المحظوظين لأن النسخة 32 ، وانا عندي الإصدار 2016 - 64 😥 

[ابوخليل]

ولا يهمك اخي العزيز

 هذه النسخة مقفلة .. سأبحث عن الأصل .. وأقدمها بإطار افضل  ان شاء الله

[Foksh]

جزاك الله عنا كل الخير ..

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

تم تعديل منذ 14 ساعات بواسطه Foksh

[ابوخليل]

تفضل 

علما انه تم استبدال المرفق السابق بهذا

الفكرة بسيطة جدا .. اولا واخيرا هي فكرة طبية

    Dim Dday As Integer
    Dim i As Double
    Dim sc As Integer
    Dim d1 As Date
    Dim s1 As String
    Dim m1 As Date
      i = DateDiff("d", Date, Text1)
      me.w1 = Abs(i \ 7)
      me.dx = Abs(i Mod 7)
      m1 = DateAdd("d", 280, Text1)
    Dday = Weekday(m1)
If Dday = 1 Then yom.Text = "الأحد"
If Dday = 2 Then yom.Text = "الاثنين"
If Dday = 3 Then yom.Text = "الثلاثاء"
If Dday = 4 Then yom.Text = "الأربعاء"
If Dday = 5 Then yom.Text = "الخميس"
If Dday = 6 Then yom.Text = "الجمعة"
If Dday = 7 Then yom.Text = "السبت"
  me.h1 = Format(m1, "YYYY/MM/DD")

حساب الحمل.rar

[Foksh]

4 دقائق مضت, ابوخليل said:

حساب الحمل.rar 126.28 kB · 0 downloads

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

[ابوخليل]

تفضل

ضعه في sysWoW64

قد يحتاج لتسجيل

وسوف ارفق ملف اكسس ايضا 

MSSTDFMT.rar

وهذا اكسس

وزيادة الخير خير

اظهار التاريخ الهجري

Dim i As Integer
Dim sc As Integer
Dim d As Date
Dim s As String
i = Date - t1
w1 = i \ 7
d1 = i Mod 7
m1 = t1 + 280
yom = Format(m1, "dddd")
sc = Calendar
Calendar = 0
m1.SetFocus
d = CDate(m1.Text)
Calendar = 1
s = CStr(d)
h1 = Format(s, "YYYY/MM/DD")
Calendar = sc

 

db4.rar

[Foksh]

جزااكم الله خيراً ، فعلاً تم تشغيل البرنامج بعد تسجيل الملف ، وللفائدة بطريقة التسجيل :-

افتح CMD موجه الأوامر كمسؤول ، تأكد من نسخ الملف المرفق "MSSTDFMT.DLL" في مشاركة معلمي أبو خليل الى المسار :-

C:\Windows\SysWOW64

اذا كان الويندوز 64 .

ثم اكتب الأمر التالي للتسجيل :-

regsvr32 "C:\Windows\SysWOW64\MSSTDFMT.DLL"

 

حتى تحصل على النتيجة التالية :

 

 

صورة البرنامج :-

 

أجدت فيما طرحت ، وأبدعت معلمي الفاضل  

[ناقل]

هذا برنامج اخر يقوم بنفس الوظيفة تقريبا ......................

 

في 13‏/2‏/2021 at 04:06, husamwahab said:

تفضل التعديل ارجو ان يكون طلبك

حساب تاريخ الحمل-11.rar 51.04 kB · 104 downloads

 

تم تعديل منذ 12 ساعات بواسطه ناقل

[ابو جودي]

ودى قاعدة كنت عملتها لطبيب صديقى  

 

ExpectedDeliveryDate.accdb

[ابوخليل]

20 دقائق مضت, ابو جودي said:

ودى قاعدة كنت عملتها لطبيب صديقى  

 

كلمة السر  280  

قرابة 9 أشهر  وكم يوم

هذا هو المعتاد الطبيعي .. ومع ذلك المخالف لهذه القاعدة كثير

[ابو جودي]

35 دقائق مضت, ابوخليل said:

كلمة السر  280  

قرابة 9 أشهر  وكم يوم

هذا هو المعتاد الطبيعي .. ومع ذلك المخالف لهذه القاعدة كثير

قمت بالتصميم بناء على ما شرحه لى الطبيب

[Foksh]

عمل جميل .. ويعطي معلومات مفيدة أيضاً ..

وعجبتني فكرة الشهر القمري تقريباً ، في الجملة :-

Months = GestationalAge / 30.42

 

[ابو جودي]

53 دقائق مضت, ابوخليل said:

هذا هو المعتاد الطبيعي .. ومع ذلك المخالف لهذه القاعدة كثير

وممكن تعديل المرفق ليرضى جميع الاطراف وليكون اكثر مرونة بالشكل التالى

استخدام txtCycleLength في حسابات الكود:

عند إدخال قيمة CycleLength في هذا الحقل سيأخذ الكود في اعتباره هذه القيمة لتعديل حساب تاريخ الولادة المتوقع بشكل أساسي:

• إذا كانت الدورة أطول من 28 يوم سيضيف الكود هذه الأيام الإضافية إلى الـ 280 يوم

• إذا كانت الدورة أقصر من 28 يوم سيخصم الكود الأيام المناسبة

مثال عملي:

• دورة 28 يوم: لا يتغير شيء يبقى تاريخ الولادة المتوقع كما هو (280 يوم)

• دورة 30 يوم: سيضاف يومان (280 + 2 = 282 يوم) إلى تاريخ الولادة المتوقع

• دورة 26 يوم: سيخصم يومان (280 - 2 = 278 يوم) من تاريخ الولادة المتوقع

 

 

 

ExpectedDeliveryDate(2).accdb

[ابو جودي]

واذا حد مهتم فى الموضوع ويريد حسابات ومعلومات أكثر 

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

ExpectedDeliveryDate(3).accdb

[ابوخليل]

منذ ساعه, ابو جودي said:

واذا حد مهتم فى الموضوع ويريد حسابات ومعلومات أكثر 

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

ما شاء الله .. 

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

[Foksh]

من باب النكاش لا النقاش 

الى ماذا استندت في :-

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

[ابو جودي]

والرد من باب النكاش وبعيدا عن اى نقاش لان خلاص فاضل تكــه 

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

هذه الحسابات الدراسية طبعا 

انت يا فؤش أفندى لازم تصحى الوحش اللى جوايا يعنى  

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

3 ساعات مضت, Foksh said:

حيث أن هذه المعادلات ليست دقيقة طبياً ، لأن وزن وطول الجنين يعتمدان على عوامل وراثية ، تغذوية ، وصحية للأم .

في التطبيقات الطبية الحقيقية ، يتم الاعتماد على جداول معتمدة (مثل منحنيات WHO) أو قياسات السونار

طيب بعد البحث لو اردنا نتائج اكثر دقة وبالاستناد الى هذا الموقع المتخصص 

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