Hawiii

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

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

يا عم @ابا جودى قبل مشاركة الكود هتاك مشاركة بها مثال أكسس مرفق مثالك بعد إضافة دالتي. Test TimeToLettre2.mdb

الدالة بعد التعديل: Option Explicit Function Time2Text(ByVal inTimeOrHours As Variant, _ Optional ByVal IgnoreConfirm = True) As String 'Hawiii الكاتب هاوي '01/01/2021 'لتفقيط الوقت اعتمادا على دالة أبو هادي للتفقيط العربي 'ArbNum2Text() 'أي لا بد من وجود الدالة الأصل لتعمل هذه الدالة 'المدخل إما بتنسيق تاريخ أو رقم Dim inVal As Variant Dim hh As Integer Dim nn As Byte Dim ss As Byte Dim hhh As String Dim nnn As String Dim sss As String Dim Res As String Dim Spp As Byte Time2Text = "" inVal = myNz(inTimeOrHours, "") If Not IsDate(inVal) And Not IsNumeric(inVal) Then Exit Function If IsDate(inVal) Then inVal = CDate(Format(inVal, "hh:mm:ss")) * 24 Else inVal = CDbl(inVal) End If hh = Fix(inVal): inVal = (inVal - hh) * 60 nn = Fix(inVal + 0.00001): inVal = (inVal - nn) * 60 ss = Round(inVal, 0): If ss = 60 Then ss = 59 hhh = IIf(hh = 0, "", ArbNum2Text(hh, , , "ساعة", "ساعات", vFemale)) sss = IIf(ss = 0, "", ArbNum2Text(ss, , , "ثانية", "ثوان", vFemale)) Select Case nn Case 0: nnn = "" Case 15: nnn = "ربع" Case 20: nnn = "ثلث" Case 30: nnn = "نصف" Case 45: nnn = "ثلاثة أرباع" Case Else nnn = ArbNum2Text(nn, , , "دقيقة", "دقائق", vFemale) End Select nnn = nnn & IIf(hh = 0, IIf(nn = 45, " الساعة", " ساعة"), "") If IgnoreConfirm Then If hh = 1 Or hh = 2 Then Spp = InStrRev(hhh, " ", -1): hhh = Left(hhh, Spp - 1) End If If nn = 1 Or nn = 2 Then Spp = InStrRev(nnn, " ", -1): nnn = Left(nnn, Spp - 1) End If If ss = 1 Or ss = 2 Then Spp = InStrRev(sss, " ", -1): sss = Left(sss, Spp - 1) End If End If Res = hhh Res = Res & IIf(Res = "", nnn, IIf(nnn = "", "", " و" & nnn)) Res = Res & IIf(Res = "", sss, IIf(sss = "", "", " و" & sss)) Time2Text = Res End Function Sub Test4Time2Text() Debug.Print Time2Text("00:15:00") Debug.Print Time2Text("00:30:00") Debug.Print Time2Text("01:15:00") Debug.Print Time2Text("02:30:00") Debug.Print Time2Text("15:15:02") Debug.Print Time2Text("16:01:00") Debug.Print Time2Text("22:02:00") Debug.Print Time2Text("23:09:59") Debug.Print Time2Text(24.5 + 1 / 3600) Debug.Print Time2Text(99 + 59 / 60 + 12 / 3600) End Sub

أولا: آمل من المشرف حذف الكود أعلاه لوجود أكثر من خطأ فيه. ثانيا: مصدر دالة أبو هادي https://www.officena.net/ib/topic/315-تفقيط-عربي-انجليزي-محدث/?do=findComment&comment=56740 ثالثا: مثال مرفق حسب السيد @ابا جودى رابعا: المثال عبارة عن كود في الوحدة النمطة Time2Text Time2Text_20200101.accdb

لماذا لا يمكنني التعديل على المشاركة السابقة؟! عموما هناك خطأ كتابي: فالسطر If hh = 1 Or 2 Then يعدل إلى If hh = 1 Or hh = 2 Then وهكذا للدقائق وللثواني

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

استخدام 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