Hawiii

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

جربت ، والآن دورك لتجرب هذه التواريخ: 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

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

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

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

دالة رأيتها في مواضيع الأستاذ جعفر وأعجبتني كثيرا ، وحسب تعليقه في الموضوع أنها من ضمن ملف العون في محرر الـ VBA ولكني لم أستطع العثور عليها. على كل تطوير الدالة في النقاط التالية: 1 - تسهيل إدخال التاريخين دون التفكير أيهما الأصغر أو أيهما الأكبر. 2 - إتاحة زيادة يوم على العمر أو المدة عند الرغبة (اختياري). 3 - إعطاء الناتج على شكل سنة وشهر ويوم منفصلين بقيم رقمية بالإضافة إلى ناتج الدالة النصي. Public Function YMD_Diff(inDate1 As Date, inDate2 As Date, _ Optional outY, Optional outM, Optional outD, _ Optional AddOneDay As Boolean = False) As String 'تطوير لدالة YMDDif Dim inDate3 As Date Dim iYear As Integer Dim iMonth As Integer Dim iDay As Integer Dim dInterim1 As Date If inDate2 < inDate1 Then inDate3 = inDate1 inDate1 = inDate2 inDate2 = inDate3 End If 'AddOneDay عند الرغبة في إضافة يوم في العمر أو المدة inDate1 = inDate1 - Abs(AddOneDay) 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 'إجراء لاختبار الدالة Sub Test2() Dim Date1 As Date Dim Date2 As Date Dim Y As Integer, M As Byte, D As Byte Date1 = DateSerial(1970, 3, 1) Date2 = Date Debug.Print YMD_Diff(Date1, Date2) Debug.Print "--------------------" Debug.Print YMD_Diff(Date1, Date2, Y, M, D) Debug.Print Y, M, D Debug.Print "--------------------" Debug.Print YMD_Diff(Date1, Date2, Y, M, D, True) Debug.Print Y, M, D Debug.Print "--------------------" End Sub

مثال صغير بأفكار متعددة لفحص وتنظيم إدخالات التاريخ آخر مشاركة لي في هذا الموضوع DateValidation.rar

لو احترزنا بـ : - عمل تنسيق لصندوق النص. - عمل ماسك عند الرغبة في منع المستخدم باختصار السنة بأني يكتب 1 بدلا من 2001 مثلا. - عمل نطاق للتاريخ في التحقق من صحة التاريخ Validation. وإن استطاع الإفلات من كل هذه الاحترازات نضع هذا الكود في حدث قبل التحديث لصندوق النص: Private Sub txtTestDate_BeforeUpdate(Cancel As Integer) Dim DateText As String, Char As String Dim DateLen As Byte, Pos As Byte Dim yy As Integer, mm As Integer, dd As Integer On Error Resume Next DateText = Me.txtTestDate.Text If Trim(DateText) = "" Then Exit Sub DateLen = Len(DateText) For Pos = 1 To DateLen Char = Mid(DateText, Pos, 1) If Not Char Like "[0-9]" Then DateText = Replace(DateText, Char, "/") End If Next Pos Do While InStr(1, DateText, "//") > 0 DateText = Replace(DateText, "//", "/") Loop Pos = InStr(1, DateText, "/") dd = Left(DateText, Pos - 1) DateText = Mid(DateText, Pos + 1) Pos = InStr(1, DateText, "/") mm = Left(DateText, Pos - 1) yy = Mid(DateText, Pos + 1) 'يمكنكم تبديل النطاق If yy < 1900 Or yy > 9999 Then MsgBox "السنة خارج النطاق" Cancel = True Exit Sub End If If mm < 1 Or mm > 12 Then MsgBox "الشهر خاطئ" Cancel = True Exit Sub End If If dd < 1 Or dd > Day(DateSerial(yy, mm + 1, 0)) Then MsgBox "اليوم خاطئ" Cancel = True Exit Sub End If End Sub فلنجرب ولنحكم قبضتنا على المستخدم وإذا ما نجحنا فنشناه وبدلناه بموظف مخه في راسه.

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

حتى لا يتوه القارئ - المشكلة لم تنتهي بعد تأكدنا عدم تأثير الاعدادات الإقليمية على تنسيق "التاريخ" المكتوب على شكل نص والمحصور بين علامتي الرقم # مثل #4/6/2020#. - المشكلة محصورة في الأحد عشر يوما الأولى من كل شهر. - المشكلة يقع فيها كل من المبرمج والمستخدم. - دالة DateFormat لا تحل المشكلة هي فقط تنسيق قيمة "التاريخ" سواء كانت صحيحة أو خاطئة بالشكل الصحيح لكتابته لاستخدامه في البحث والمقارنة فـ garbage in garbage out. - حل المشكلة عند المبرمج أن يكون فاهم "تنسيق التاريخ" المكتوب أو يحترز باستخدام دالة DateSerial فهذه ستحميه من أخطاء الكتابة. - حل المشكلة عند المستخدم بتثقيفه بالتنسيق المطلوب إدخاله أو بإجباره من قبل المبرمج إما بكتابة شكل التنسيق أعلى الصندوق أو بتقسيم خانة التاريخ إلى خانات يوم وشهر وسنة. - تبقى دالة Format مهمة في مخرجات نصية للتاريخ حسب الرغبة. - وتبقى الإعدادات الإقليمية مهمة في مخرجات نصية بتنسيق موحد للتاريخ حسب الضبط المسبق. - على القارئ أن لا يخلط بين تنسيق التاريخ والتنسيق النصي كالتالي: #4/6/2020# هذا تنسيق تاريخ أي نوعه تاريخ وليس نص ولا يحتاج إلى تحويل من نص إلى تاريخ وهذا يمثل 6 أبريل 2020م. "06/04/2020" هذا تنسيق نصي أي نوعه نص ولو أردنا قيمته كتاريخ يحتاج إلى تحويل وسوف يتأثر بالإعدادات الإقليمية عند تحويله وقد يمثل 6 أبريل أو 4 يونيو 2020م.

أعتذر لتمريري معلومة خاطئة لكم وهي تأثير تنسيق تاريخ البحث المحصور بين علامتي # بالاعدادات الإقليمية لنظام التشغيل والصحيح أنه لا يتأثر وتنسيقه ثابتا دائما ولكن على خلاف ما اعتدنا عليه في كتابة التاريخ فكتابته لابد أن تكون mm/dd/yyyy أي نبدأ بالشهر ثم اليوم ثم السنة ابتداء من اليسار. ومع ذلك حتى لو اعتدنا على استخدامه بالشكل الصحيح فأنا لازلت على نصيحتي فهي أكثر اطمئنانا. اقرأوا أكثر: Excel VBA Dates & Time, Format Function, User Defined Date, Number & String Formats

ووالديك أستاذنا جعفر

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

أخي ما المشكلة مع هذه الدالة؟ ، هل جربت إضافتها وتجربتها؟ أنا انتبهت أني عكست التنسيق المطلوب ويمكن هذا السبب! Function GetAge(Birthdate As Date) As String Dim Age As Double Age = Date - Birthdate GetAge = Format(Day(Age) - 1, "00-") & _ Format(Month(Age) - 1, "00-") & _ Format(Year(Age) - 1900, "0000") End Function وتستطيع مناداتها كالتالي' = GetAge([DOB]) & " year(s)" '----------------------------------------------------------------- أما إذا أردت السنوات فقط فيمكنك عملها كالتالي مع التقريب لأقرب سنة' Function GetYears(Birthdate As Date) As Byte GetYears = Round((Date - Birthdate) / 365.24, 0) End Function 'أو بدالة DateDiff Function GetYears(Birthdate As Date) As Byte GetYears = DateDiff("yyyy", Date, Birthdate) End Function وتستطيع مناداتها كالتالي' = GetYears([DOB]) & " year(s)" ويمكنك لصق الدالتين في موديول منفصل وهو الأفضل أو في موديول النموذج نفسه.

لم أتعود على كتابة الأمثلة وهذه مقدرتي ، من يمتلك هذه الملكة فليقوم بالاختبارات وعمل أمثلة أكثر وضوحا. من أهم ما أشدد على الالتزام به هو أن تستخدم دالة تحويل التاريخ إلى رقم لجهتي المقارنة أي حقل الجدول و قيمة البحث. Sub Test4() Dim TestDate As Date Dim SearchText As String '----------------------------------------------------------- 'المعتاد SearchText = "Birthdate=" & #10/4/2020# 'الاحترازي TestDate = DateSerial(2020, 4, 10) SearchText = "CLng(Birthdate)=" & CLng(TestDate) '-------------------------------------------------------- 'المعتاد SearchText = "Birthdate=" & #10/4/2020 11:43:30 PM# 'الاحترازي TestDate = DateSerial(2020, 4, 10) + TimeSerial(23, 43, 30) SearchText = "CDbl(Birthdate)=" & CDbl(TestDate) End Sub Sub Test5() Dim SearchText As String SearchText = #10/4/2020# Debug.Print CDate(SearchText) 'الناتج 04/10/2020 Debug.Print DateSerial(2020, 4, 10) 'الناتج 10/04/2020 '-------------------------------------------------------- SearchText = #4/13/2020# 'كتبتها 13/4/2020 وحولها المحرر 4/13/2020 Debug.Print CDate(SearchText) 'الناتج 13/04/2020 Debug.Print DateSerial(2020, 4, 13) 'الناتج 13/04/2020 End Sub

بمجرد أن يكون اليوم أكبر من أو يساوي 12 غالبا تنتهي مشاكل التاريخ بسبب الخلط بين اليوم والشهر متأثرا بتنسيق نظام التشغيل. ولكن إذا قل اليوم عن 12 وهو القيمة الكبرى للشهور تبدأ أحيانا مشاكل الخلط وبالتالي اختلاف قيمة التاريخ وخصوصا إذا كتب التاريخ على شكل نص وحصره بعلامتي الرقم #. طريقتي في الاحتراز: تحويل التاريخ إلى رقم باستخدام أربع دوال كالتالي: - إذا كان التاريخ بدون وقت يمكن استخدام دالة CLng. - إذا كان التاريخ يحتوي على وقت ينصح باستخدام دالة CDbl. - إذا كان التاريخ على شكل نص مثل #10/04/2020# وهذا أخطرها ينصح باستخدام دالة DateSerial ليصبح DateSerial(2020, 4, 10). - وإذا كان على شكل نص ويحتوي على وقت مثل #10/4/2020 11:43:30 PM# ينصح بإضافة دالة TimeSerial ليصبح DateSerial(2020, 4, 10) + TimeSerial(23, 43, 30). قد يستثقلها المبرمج ويرى فيها تعقيدا ولكن كاحتراز فهي مطلوبة بشدة وخصوصا إذا كانت البرامج لها علاقة بحسابات وأمور يترتب علي أخطائها أضرارا. هذا اجتهادي وقد أكون صائبا وقد أكون مخطئا.

جرب هذه الدالة: Function GetAge(Birthdate As Date) As String Dim Age As Double Age = Date - Birthdate GetAge = Format(Year(Age) - 1900, "0000-") & _ Format(Month(Age) - 1, "00-") & _ Format(Day(Age) - 1, "00") End Function

العفو منكم أنتم أساتذتنا دالة TypeName جميلة وهي أسرع لمعرفة النوع من الرقم أو الرمز. مع ملاحظة أني ذكرت أي متغير لا يتم تعريفه سيكون من نوع Variant ولكن عند التجربة سيعطيك Empty وكلاهما صح ولو أعطيته أي قيمة سوف يعطيك نوع مختلف عن الإثنين ، فالنوع Variant بمعنى متنوع يقبل أي قيم من أي نوع وسوف يعطيك Empty كذلك حتى لو عرفته بـ Variant في حال لم تعطه أي قيمة.

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

من الأخطاء الشائعة في المنتدى تعريف المتغيرات بصورة غير صحيحة في الـ VBA، مع أن هذه الطريقة صحيحة في بعض اللغات. والخطأ هو صف مجموعة متغيرات في تعريف واحد ، وفي هذه الحالة سوف يتم تعريف المتغير الأخير فقط أما المتغيرات التي قبله سوف سوف يكون نوعها Variant والصح هو تعريف كل متغير على حدى مثال: 'الخطأ Sub Test() Dim a, b As Double Dim rst1, rst2 As Recordset Debug.Print VarType(a) Debug.Print VarType(b) Debug.Print VarType(rst1) Debug.Print VarType(rst2) End Sub 'الصح Sub Test2() Dim a As Double, b As Double Dim rst1 As Recordset, rst2 As Recordset Debug.Print VarType(a) Debug.Print VarType(b) Debug.Print VarType(rst1) Debug.Print VarType(rst2) End Sub

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

حياك الله أستاذنا جعفر ، الحقيقة كلامك يحتاج إلى توضيح: ليس من الكود؟ مو هذا المطلوب؟ عموما أنا علقت على خطأ في كتابة الكود وأعتقد هذا هو الصح أن لا تمرر الأخطاء كمسلمات ، وإلا إذا السائل ما عرف خطأه كيف له أن يتعلم ويصلح أخطاءه أو يقلل منها!! أنا قلت أن هناك ملاحظات على الكود ومع ذلك عند قراءتي للكود كنت واثق أنه سينفذ المطلوب ولم أشأ أن أتدخل إلا لما سألني مرة أخرى فاختصرت الموضوع وأجريت تعديل شامل بشكل نموذجي حسب اجتهادي ولو وجه السؤال لك لم تدخلت. على كل حتى مع تصحيحك لخطأ قيمة الـ True من 1 إلى -1 ، بقى هناك تكرار لنفس الخطأ لم تلحظه. وكذلك ملاحظتي للاستخدام الخاطئ لـ ElseIf هو كذلك مكرر في الكود ثلاث مرات وليس مرة واحدة. عموما أنا معكم بشكل مؤقت حتى تنتهي مشكلة الكورونا ثم نتفرغ لما هو أهم بالنسبة لأولوياتي ، وأنا هنا فقط أشغل وقتي في شيء يفيد الناس ولا مشكلة عندي للانسحاب إذا كانت مداخلاتي ستسبب مشكلات لكم وأنتم أولى بهذا المنتدى مني فما أنا إلا ضيف طارئ ومؤقت. ملاحظة وأرجو أن لا تزعلوا مني ، المنتدى في كتابة الأكواد بشكل عام متواضع ويلزمكم استقطاب خبراء فن الكتابة 🙂

If Me.dd Then if vbYes = MsgBox("?? ??E ?E??I ?? ?UEE? ??? ?C?E C????C? ?? C??CE??E?", vbYesNo, "??? C????C? ?? C??CE??E") Then 'DoCmd.SetWarnings False DoCmd.OpenQuery "C?E??C? ??? ?CE??E" Me.dd = Not Me.dd 'DoCmd.SetWarnings True Else MsgBox "E? C?E?C?? ?? C????" End If Else if vbYes = MsgBox("?? ??E ?E??I ?? ?UEE? ??C?E C???? ???CE??E?", vbYesNo, "??U C????") Then 'DoCmd.SetWarnings False DoCmd.OpenQuery "Q1" DoCmd.OpenQuery "Q2" Me.dd = Not Me.dd 'DoCmd.SetWarnings True Else MsgBox "E? C?E?C?? ?? C???U" DoCmd.CancelEvent End If End If

توجد عدة ملاحظات على الكود ، ولكني سأضيف على الأستاذ جعفر هذه الملاحظة: عند حصر الاختيار في قيمتين فقط مثل نعم ولا ، صح وخطأ فلا داعي لاستخدام ElseIf كما التالي: If Me.dd = -1 Then ElseIf Me.dd = 0 Then End If والأصح أن تكتب هكذا: If Me.dd = -1 Then Else End If ويمكن كتابتها بشكل مختصر كالتالي: If Me.dd Then Else End If