كل الانشطه

والرد من باب النكاش وبعيدا عن اى نقاش لان خلاص فاضل تكــه هذه الحسابات تستند إلى نمو الجنين الطبيعي خلال مراحل الحمل وفقا لدراسات طبية وملاحظات حول كيفية تطور الجنين في الرحم في كل أسبوع من أسابيع الحمل هذه الحسابات الدراسية طبعا انت يا فؤش أفندى لازم تصحى الوحش اللى جوايا يعنى طيب بعد البحث لو اردنا نتائج اكثر دقة وبالاستناد الى هذا الموقع المتخصص 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

السلام عليكم ورحمة الله وبركاته طلب مساعدة إخواني الكرام في جدول إدارة الأسماء في الإكيل . الجداول حسب عدد الموظفين الذي أريد .وشكرا منظومة-الشؤون-الادارية أوفيسنا.xlsm

مشكور تظهر هذه الرسالة

تفضل استاذ @RAIANESAMI . اليك المرفق والشرح بعد اضافة طلبك . تم اضافة الحقل (FileNO) رقم العملية وهو يعد العمليات لكل موظف بدون تدخل منك. جرب بالرد . DDFinding Differences-FINAL_5.rar

وممكن تعديل المرفق ليرضى جميع الاطراف وليكون اكثر مرونة بالشكل التالى استخدام txtCycleLength في حسابات الكود: عند إدخال قيمة CycleLength في هذا الحقل سيأخذ الكود في اعتباره هذه القيمة لتعديل حساب تاريخ الولادة المتوقع بشكل أساسي: إذا كانت الدورة أطول من 28 يوم سيضيف الكود هذه الأيام الإضافية إلى الـ 280 يوم إذا كانت الدورة أقصر من 28 يوم سيخصم الكود الأيام المناسبة مثال عملي: دورة 28 يوم: لا يتغير شيء يبقى تاريخ الولادة المتوقع كما هو (280 يوم) دورة 30 يوم: سيضاف يومان (280 + 2 = 282 يوم) إلى تاريخ الولادة المتوقع دورة 26 يوم: سيخصم يومان (280 - 2 = 278 يوم) من تاريخ الولادة المتوقع ExpectedDeliveryDate(2).accdb

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

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

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

جزاكم الله خيرا

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

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

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

تفضل ضعه في 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

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

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