Hawiii

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

استخدام DoEvents لمنع التزاحم ، جربوا هذه الطريقة ربما تفلح: DoEvents: cmdButton1_Click DoEvents: cmdButton2_Click DoEvents: cmdButton3_Click

ويمكنكم استخدام هذه الدالة أيضا: Function DayPart(inTime As Date) As String Dim timePart As Byte timePart = Fix((CDate(Format(inTime, "hh:mm:ss")) * 24) / 6) Select Case timePart Case 1: DayPart = "صباحا" Case 2: DayPart = "مساءً" Case Else: DayPart = "ليلا" End Select End Function

فقط حول الوقت إلى ساعات ودقائق باستخدام دالتي Hour و Minute ثم عاملهم كعملة بنفس دالة التفقيط التي لديك أو ابحث عنها في المنتدى وعرف الساعات بـ ساعة للمفرد وساعاتان للمثنى و ساعات للجمع وجنسها مؤنث وعرف الدقائق بـ دقيقة للمقرد ودقيقتان للمثنى ودقائق للجمع وجنسها مؤنث أيضا يبقى عملية تحويل الدقائق إلى تفقيط كسور يمكن عملها بسهولة والشباب ما رايح يقصرون معك مع أن أرى أن لا داعي لها وستستخدمها مع 15 ، 20 ، 30 و 45 دقيقة. موفق.

لم أفتح محرر الفجوال ولم أجرب ، الكتابة مباشرة: أقسم الرقم على 10 ثم قربها وبعدها اضرب الناتج في عشرة Round(myNum / 10, 0) * 10 كما يوجد دالة Roundup يمكنكم تجربتها ومعرفة الفرق بينها وبين الدالة Round إن شاء الله تطلع الدالة تبع ال VBA 🙂

مرحبا لم أقرأ كل الردود فقد يكون هناك حلا نموذجيا لم أنتبه له ، فالمعذرة. هذا حل أستخدمه دائما وهو حل ناجح 100% Public Const Duplicate = 3022 With rst Do Err.Clear .AddNew !ID = Nz(DMax("ID", "MyTable"), 0) + 1 !Date = Date .Update Loop Until Err.Number <> Duplicate End With

جرب هذا الكود وإذا نجح طبقه على الباقي. Private Sub F1_AfterUpdate() Me.F2.Requery Me.F3.Requery Me.F4.Requery End Sub

آمل أن لا يكون في مشاركتي مخالفة .. وأعتذر مقدما ولكم كل الحق في حذفها. وجدت هذا الموضوع ربما يكون فيه الحل المطلوب. موضوع لمفرج .. فكرة تحجيم الحقل

لاحظت ملاحظتين: - بمجرد الخروج من الموقع يتحول إلى اللغة الإنجليزية ولا خيار لتغيير اللغة. - خيار الدخول متخفيا لا يظهر.

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

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

جرب هذا الحل - غير حقل الهجري من تاريخ إلى نص ، وأزل القيمة الافتراضية. - في استعلام الإضافة/الحفظ أضف حقل إضافة تاريخ أم القرى كما الصورة.

إنت مبرمج يفترض أنك تقرأ الكود والنتائج بكل سهولة. خمس نتائج من أصل 366 فيها اختلاف بيننا ، ولتسهيل تمييز الصح من الخطأ أخذت أول خطأين من الخمسة وعملت عليهما مقارنة ثانية لإظهار نتيجة اليوم السابق ثم اليوم الذي به اختلاف ثم اليوم التالي. وتحيات لأبي آمنة 🙂 .

الاختبار الأخير ومشاركتي الأخيرة ، ومبروك عليك الكأس من أبوآمنة 🙂 الاختبار لمدة سنة ، 🖐️ Sub Test2() Dim Date1 As Date, Date2 As Date Dim sDate As Date, eDate As Date Dim dd As Integer, Days As Integer Date1 = DateSerial(2019, 1, 28) Date2 = DateSerial(2020, 1, 29) sDate = Date1: eDate = Date2 Days = Date2 - Date1 Debug.Print " From", " To", " YMDDif", " Hawiii" For dd = 0 To Days Date1 = sDate + dd If YMDDif(Date1, Date2) <> GetAge(Date1, Date2) Then Debug.Print Date1 & " - " & Date2, YMDDif(Date1, Date2), GetAge(Date1, Date2) End If Next dd Debug.Print "---------------------- End ------------------------" Date1 = DateSerial(2019, 3, 1) Debug.Print , , YMDDif(Date1 - 1, eDate), GetAge(Date1 - 1, eDate) Debug.Print , , YMDDif(Date1 + 0, eDate), GetAge(Date1 + 0, eDate) Debug.Print , , YMDDif(Date1 + 1, eDate), GetAge(Date1 + 1, eDate) Debug.Print "---------------------------------------------------" Date1 = DateSerial(2019, 4, 30) Debug.Print , , YMDDif(Date1 - 1, eDate), GetAge(Date1 - 1, eDate) Debug.Print , , YMDDif(Date1 + 0, eDate), GetAge(Date1 + 0, eDate) Debug.Print , , YMDDif(Date1 + 1, eDate), GetAge(Date1 + 1, eDate) Debug.Print "---------------------------------------------------" End Sub النتائج From To YMDDif Hawiii 01/03/2019 - 29/01/2020 0y/10m/28d 0y/11m/0d 30/04/2019 - 29/01/2020 0y/8m/30d 0y/8m/29d 30/06/2019 - 29/01/2020 0y/6m/30d 0y/6m/29d 30/09/2019 - 29/01/2020 0y/3m/30d 0y/3m/29d 30/11/2019 - 29/01/2020 0y/1m/30d 0y/1m/29d ---------------------- End ------------------------ 0y/11m/1d 0y/11m/1d 0y/10m/28d 0y/11m/0d 0y/10m/27d 0y/10m/27d --------------------------------------------------- 0y/9m/0d 0y/9m/0d 0y/8m/30d 0y/8m/29d 0y/8m/28d 0y/8m/28d ---------------------------------------------------

كلامك صحيح 100% دالتك أعطت أفضل نتائج لاحتساب الأعمار رأيتها في حياتي .. أهنيك ، أنت خطير يا جعفر. أخطأء عدم الاحتراز في مدخلات الدوال باستخدام ByVal يسبب بلاوي ، وهذه غلطة الشاطر ، أنا حريص على استخدامها ولكن في تجاربي مع هذه الدالة "العلة" غفلت عنها وخلتني أجيب العيد. كذلك أنت ساعدتني في التيه بتغييرك اسم الدالة ، لو لم تبدل اسمها إلى YMDDif4 لأخذت وقت أكثر في الاختبار الأخير والمقارنة. لك مني اعتذاري وتقديري. المفاجأة أن نتائج دالتك أتت بنفس نتائج دالتي التي قلت عنها معقدة فهي طويلة وأسطره زادت على 90 سطر. الاختبار قبل الأخير: Sub Test2() Dim Date1 As Date Dim Date2 As Date Dim sDate As Date Dim dd As Byte Debug.Print "YMD_Diff", " YMDDif", " Age", "Hawiii" Date1 = DateSerial(1997, 1, 28) Date2 = DateSerial(2000, 2, 29) sDate = Date1 For dd = 0 To 5 Date1 = sDate + dd Debug.Print YMD_Diff(Date1, Date2), YMDDif(Date1, Date2), Age(Date1, Date2), GetAge(Date1, Date2) Next dd End Sub النتائج YMD_Diff YMDDif Age Hawiii 3y/1m/1d 3y/1m/1d 3y/1m/1d 3y/1m/1d 3y/1m/1d 3y/1m/0d 3y/1m/0d 3y/1m/0d 3y/1m/1d 3y/0m/30d 3y/1m/0d 3y/0m/30d 3y/1m/1d 3y/0m/29d 3y/1m/0d 3y/0m/29d 3y/0m/28d 3y/0m/28d 3y/0m/28d 3y/0m/28d 3y/0m/27d 3y/0m/27d 3y/0m/27d 3y/0m/27d لي اختبار أخير لمدة أطول لتأكيد هذه النتبيجة ، مع أني شبه متيقن أني لن أخرج بجديد ولكن بما أن هذا الموضوع وترنا فلنتركه بنتيجة حاسمة.

هذه دالة نشرها مبرمج اسمه "أبو هاجر" عام 2003 في منتديات الفريق العربي للبرمجة ويقول أنه حصل عليها من الإنترنت. سوف أقوم بعمل مقارنات غدا إن شاء الله تعالى. Function Age(DateFm As Date, DateTo As Date) As String Dim TempDate As Date Dim M As Long M = DateDiff("m", DateFm, DateTo) TempDate = DateAdd("m", M, DateFm) If TempDate > DateTo Then M = M - 1 TempDate = DateAdd("m", M, DateFm) End If yy = Fix(M / 12) mm = M Mod 12 dd = DateDiff("d", TempDate, DateTo) 'Age = Format(yy, "00") & " - " & Format(mm, "00") & " - " & Format(dd, "00") Age = y & "y/" & M & "m/" & d & "d" End Function

فحص لفترتين فقط Sub Test2() Dim Date1 As Date Dim Date2 As Date Dim yy As Integer, mm As Byte, dd As Byte Debug.Print "YMD_Diff", "YMDDif" Date1 = DateSerial(1970, 2, 28) Date2 = DateSerial(1970, 3, 1) Debug.Print YMD_Diff(Date1, Date2), YMDDif(Date1, Date2) Date1 = DateSerial(1970, 1, 31) Date2 = DateSerial(1970, 2, 27) Debug.Print YMD_Diff(Date1, Date2), YMDDif(Date1, Date2) 'Debug.Print "--------------------" 'Debug.Print YMD_Diff(Date1, Date2, yy, mm, dd) 'Debug.Print yy, mm, dd 'Debug.Print "--------------------" 'Debug.Print YMD_Diff(Date1, Date2, yy, mm, dd, True) 'Debug.Print yy, mm, dd 'Debug.Print "--------------------" End Sub النتائج: YMD_Diff YMDDif 0y/0m/1d 0y/0m/4d 0y/0m/27d 0y/0m/30d لاحظ أن النتائج هنا لا تخص الأصل ، أنت أتيت بنتائج لدالة معدلة اسمها YMDDif4 إذا أردت المزيد فأنا متفرغ لك اليوم ، آمرني بس وابشر بعزك.

واضح عندك مشكلة 🙂 ضع لي دالتك التي تعطي نتائج صحصحة ، والتي لم يقم غيرك بالإضافة عليها.

تنقيح للمشاركة الأخرة ، كوني لم أستطع التعديل عليها: Public Function YMD_Diff(inDate1 As Date, inDate2 As Date, _ Optional outY, Optional outM, Optional outD, _ Optional AddOneDay As Boolean = False) As String Dim iYear As Integer Dim iMonth As Integer Dim iDay As Integer Dim dInterim1 As Date 'تصرف من Hawiii ------------------------------------- Dim bkDate1 As Date, bkDate2 As Date bkDate1 = inDate1: bkDate2 = inDate2 If inDate2 < inDate1 Then inDate1 = inDate2: inDate2 = bkDate1 End If Do While Month(inDate1) = 2 Or Month(inDate2) = 2 Or Month(inDate1 - 1) = 2 inDate1 = DateAdd("m", 1, inDate1) inDate2 = DateAdd("m", 1, inDate2) Loop 'AddOneDay عند الرغبة في إضافة يوم في العمر أو المدة inDate1 = inDate1 + AddOneDay 'inDate1 - Abs(AddOneDay) 'تصرف من Hawiii ------------------------------------- iMonth = DateDiff("m", inDate1, inDate2) If Day(inDate1) > Day(inDate2) Then iMonth = iMonth - 1 End If dInterim1 = DateAdd("m", iMonth, inDate1) outD = DateDiff("d", dInterim1, inDate2) outM = iMonth Mod 12 outY = iMonth \ 12 'تصرف من Hawiii ------------------------------------- If outY + outM = 0 Then outD = Abs(bkDate2 - bkDate1) + Abs(AddOneDay) 'تصرف من Hawiii ------------------------------------- YMD_Diff = outY & "y/" & outM & "m/" & outD & "d" End Function

وعليكم السلام ورحمة الله وبركاته. لقد قلت أن هذه الدالة ليست دالتي ، ودالتي التي أوصفها بالمتينة دالة لم أنشرها ، وكان تصرفي السابق هو تسهيل الإدخال حتى لا يضطر المستخدم يضيع وقته أيهما التاريخ الأصغر وأيهما الأكبر وكذلك تنويع المخرجات ففي السابق تعطي ناتج نصي وأنا أضفت عليه إرجاع قيم السنة والشهر واليوم منفصلة وكذلك أدخلت عليها إختياريا إضافة يوم على المدة. يعني لم أتدخل في نتائجها ، فهي ليست دالتي ولو هي دالتي فلن أستحي من وجود أخطاء في نتائجها ، ما مشكلتكم؟!!! تعديلي الأخير هو تفادي (بعض أخطائها) وهو الهروب من شهر فبراير و عندما تقل المدة عن شهر أقوم بإرجاع الأيام بالشكل التقليدي فقط. وإذا تريدني أختبر (دالتك) إختبارا قويا ، دلني عليها وضعها في رد منفصل حتى لأ أتوه مع الردود.

جربت ، والآن دورك لتجرب هذه التواريخ: Date1 = DateSerial(1970, 2, 28) Date2 = DateSerial(1970, 3, 1) Date1 = DateSerial(1970, 1, 31) Date2 = DateSerial(1970, 3, 1) أنا عندي دالتي الخاصة وهي معقدة ومتينة جدا ولن أنشرها لعلمي أن الحقوق الفكرية في المنتديات العربية منتهكة ولن تعطى حقها في التقييم كما العادة سترى من يجهد نفسه فقط لإسقاطها وآخرين يتجاهلونها لأنهم لا يملكون الشجاعة في الاعتراف بقدرات غيرهم ، أعرف سوف تنتقدوني على كلامي هذا ولكن هذه الحقيقة للأسف. أنا جديد على منتداكم ولكني لست جديدا على عالم البرمجة والمنتديات كمبرمج وكمشرف وكمراقب وكمقيم وكمحكم ، ومشاركاتي هنا لمن يرغب في التنويع والاستزادة بالإضافة إلى خبرات ومعارف أساتذة المنتدى وليس لي أي طموح لمنافسة أو مزاحمة أحد. لقد قمت بتعديل آخر على الدالة وربما تكون الأخيرة وربما لا: Public Function YMD_Diff(inDate1 As Date, inDate2 As Date, _ Optional outY, Optional outM, Optional outD, _ Optional AddOneDay As Boolean = False) As String Dim iYear As Integer Dim iMonth As Integer Dim iDay As Integer Dim dInterim1 As Date 'تصرف من Hawiii ------------------------------------- Dim bkDate1 As Date, bkDate2 As Date bkDate1 = inDate1 bkDate2 = inDate2 If inDate2 < inDate1 Then inDate1 = inDate2 inDate2 = bkDate1 End If Do While Month(inDate1) = 2 Or Month(inDate2) = 2 Or Month(inDate1 - 1) = 2 inDate1 = DateAdd("m", 1, inDate1) inDate2 = DateAdd("m", 1, inDate2) Loop 'AddOneDay عند الرغبة في إضافة يوم في العمر أو المدة inDate1 = inDate1 - Abs(AddOneDay) bkDate1 = bkDate1 - Abs(AddOneDay) 'تصرف من Hawiii ------------------------------------- iMonth = DateDiff("m", inDate1, inDate2) If Day(inDate1) > Day(inDate2) Then iMonth = iMonth - 1 End If dInterim1 = DateAdd("m", iMonth, inDate1) outD = DateDiff("d", dInterim1, inDate2) outM = iMonth Mod 12 outY = iMonth \ 12 'تصرف من Hawiii ------------------------------------- If outY + outM = 0 Then outD = Abs(bkDate2 - bkDate1) 'تصرف من Hawiii ------------------------------------- YMD_Diff = outY & "y/" & outM & "m/" & outD & "d" End Function نصيحتي لمن يرغب في اختبار دوال العمر أو المدة أن يطبع نتائجها لمدة عام كامل مثلا من 01/01/2020 إلى 31/12/2020 مع تثبيت البداية والتبديل في النهاية ، فإذا تكررت نتيجتين فقط من أصل 366 يوم فهذا دليل على عدم متانة الدالة مع ملاحظة أن أحيانا النتائج نراها غير مقنعة عند مقارنتها بالنظر أو بالحسابات التقليدية.

الدالة ليست من تصميمي ومع ذلك الخطأ ليس بسبب المبرمج ، هي مشكلة شهر فبراير وفرق الأيام التي تصل إلى ثلاثة أيام ، وليس لها حل. هذا حل عبارة عن تحايل للهروب من شهر فبراير من التاريخين للحصول على نتيجة مرضية ويبقى فرق التاريخ بين الشهور التي مدتها 30 و 31 يوم يوقع الدالة في نفس المشكلة ولكن بشكل مقبول لا يتجاوز اليوم الواحد. Public Function YMD_Diff(inDate1 As Date, inDate2 As Date, _ Optional outY, Optional outM, Optional outD, _ Optional AddOneDay As Boolean = False) As String Dim inDate3 As Date Dim iYear As Integer Dim iMonth As Integer Dim iDay As Integer Dim dInterim1 As Date 'تصرف من Hawiii ------------------------------------- If inDate2 < inDate1 Then inDate3 = inDate1 inDate1 = inDate2 inDate2 = inDate3 End If Do While Month(inDate1) = 2 Or Month(inDate2) = 2 Or Month(inDate1 - 1) = 2 inDate1 = DateAdd("m", 1, inDate1) inDate2 = DateAdd("m", 1, inDate2) 'Debug.Print inDate1, inDate2 Loop 'AddOneDay عند الرغبة في إضافة يوم عند العمر أو المدة inDate1 = inDate1 - Abs(AddOneDay) 'تصرف من Hawiii ------------------------------------- iMonth = DateDiff("m", inDate1, inDate2) If Day(inDate1) > Day(inDate2) Then iMonth = iMonth - 1 End If dInterim1 = DateAdd("m", iMonth, inDate1) outD = DateDiff("d", dInterim1, inDate2) outM = iMonth Mod 12 outY = iMonth \ 12 YMD_Diff = outY & "y/" & outM & "m/" & outD & "d" End Function

أعتذر عن المواصلة معكم في هذا المنتدى النشط ، وقد أزوركم بشكل شهري أو ربع سنوي لنتشرف برؤية أسماء أساتذتنا الكرام إن شاء الله لوأمد في عمري.

من الغريب لا يوجد من يرجع لنا بنتائج فحص المثال ، بالإيجاب أم بالسلب. تصميم أمثلة يتطلب وقتا أكبر من وقت الفحص أو التجربة ، فمراجعتكم مطلوبة لتطوير حلول مرجعية متينة.

اسمح لي أخي أنا غير متفرغ وأتجنب عمل أمثلة لأنها تأخذ من وقتي ، ربما أحد فرسان المنتدى "يفزع" معك ويصمم لك مثالا. هذا رابط به مثال لنفس الدالة قبل تعديلي ، يمكنك المقارنة ومعرفة الفرق وإضافته أو تركه: مثال لحساب العمر