Hawiii

دالة رأيتها في مواضيع الأستاذ جعفر وأعجبتني كثيرا ، وحسب تعليقه في الموضوع أنها من ضمن ملف العون في محرر الـ 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

حسب فهمي لطلبك: 75%.xlsx

الرسالة كما فهمتها تم بتبديل صندوق ZVisitorName1 من ComboBox إلى TextBox فلذلك لم تعد خاصية الأعمدة Column متوفرة.

لا مشكلة مع الكود فقط هو اختلاف في نوع الفاصلة للنظام ، بدل الفولصل إلى منقوطة. من ، إلى ؛

ممكن تجرب هذه الكود: =Nz(DSum("am_re","Pu_inv","ty_pu='بيع' And CLng(Fix(Da_te))=" & CLng(Fix([Da_te]))),0)

جرب هذه الدالة: Function myRound(ByVal Num As Double) As Double Dim DecOld As Double Dim DecNew As Double DecOld = Num - Int(Num) Num = Int(Num) 'If DecOld < 0.3 Then If DecOld < 0.29999999999 Then DecNew = 0 ElseIf DecOld >= 0.7 Then DecNew = 1 Else DecNew = 0.5 End If myRound = Num + DecNew End Function

ويمكن استخدام دالة IsNull كالتالي: If IsNull(Me.[السنة]) Then