AbuuAhmed

@محمد ابومروان 🙂 ظلمت الإكسل ، مع أني محترف كتابة شفرات ولكن لا أنصحك باللجوء إلى الفيجول إلا إذا عجز الإكسل عن الحل. موفقين. وهذا إذا أردته للنموذج Private Sub TextBox2_Change() Dim cd As String cd = Me.ActiveControl If Len(cd) <> 14 Then Exit Sub Me.TextBox3 = DateSerial(1700 + Left(cd, 1) * 100 + Mid(cd, 2, 2), Mid(cd, 4, 2), Mid(cd, 6, 2)) End Sub

علاج مؤقت ، وقد يكون له آثار جانبية عطلت عبارة if في دالة UmCDate والمشكلة بسبب أن الشفرة اعتبرت أن التاريخ على ما أعتقد ميلادي ويوم 30 أكبر من مدة شهر فبراير.

جرب الآن Book12_03.xlsm

أحتاج رقم قومي بعد عام 1999 Book12_02.xlsm

التقويم المطلوب هجري النظام أم أم القرى؟

جرب الآن Gyab_New_03.rar

جرب وخبرنا list_03.xlsx

يمكنت تبديل "" إلى صفر من خلال المعادلة Copy of Book1_02.xlsx

لا أنصح باللجوء إلى الفيجوال إلا في حالة استعصاء عمل المعادلات المعقدة في الإكسل. بدل الحدث من SelectionChange إلى حدث Change وجرب.

عملك سليم ويمكنك الحصول على مطلبك من نفس الاستعلام أو بعمل استعلام ثاني مصدره الاستعلام الأول. تعديلي في الاستعلام الأول Uni_02.rar

أضفت لك أكواد تقويم أم القرى من موقع أبو هادي مع تصرف بسيط مني في دالة UmDateDiff. حساب الترقيات.xlsm

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

لا يمكن أن نصل إلى تحويل للتاريخ بمعادلة من سطر واحد وباستخدام المتوسطات. ما عملته أنا فقط للحصول على السنة الهجرية ليس إلا ، فلا يذهب تعبكم سدى ، فالتقاويم لها قوانين وتفاصيل كثيرة مثل مدد الشهور ونطام الدورات والكبس. هذه دالة فحصي للمعادلة لمن يريد أن يكثر من الاختبارات واللعب على قيمة الضبط: Sub HijriYearTest() Dim Hyy As Long Dim Days As Long Dim Greg As Long Dim Hijri1 As Long Dim Hijri2 As Double For Hyy = 1 To 9666 Greg = Hijri2Greg(Hyy, 1, 1) For Days = Greg - 1 To Greg Hijri1 = Left(Greg2Hijri(CDate(Days)), 4) 'Hijri2 = (Days + 466580.47) / 354.366666666667 + 1 Hijri2 = (Days + 466581 - 0.53) / (10631 / 30) + 1 If Hijri1 <> Fix(Hijri2) Then Debug.Print CDate(Days), Hijri1, Hijri2 End If Next Days Next Hyy Debug.Print "Done" End Sub

(Date + 466581 - 0.53) / (10631 / 30) + 1 Date يمثل التاريخ الميلادي للأكسس والإكسل و الـ vba 466581 هو الرقم التسلسلي لبداية التقويم الميلادي في 18/07/0622 زائدا واحد حتى تكون النتيجة المطلوبة تساوي يوم واحد. طبعا الرقم التسلسلي يساوي 466580- نصفره ونضيف عليه يوم واحد وهو قيمة بداية التقويم الهجري (أول يوم). (10631 / 30) هو طول السنة الهجرية بالأيام وناتجها 354.367 ولكني فضلت استخدم عملية التقسيم حتى أحصل على كسر مفتوح لمزيد من الدقة. 0.53 هو لعملية ضبط adjustment حصلت عليه بعد عدة تجارب/اختبارات وتظهر حاجته غالبا في آخر يوم في السنة وأحيانا في أول يوم أيضا. 1 هو للسنة الناقصة (غير المكتملة)

تم اختبار المعادلة لمدة 9566 سنة هجرية بدون أي إخفاق. ملاحظة: هذه المعادلة تعمل فقط مع الـ vba و الإكسل

إليك هذه المقارنة

جرب المعادلة التي اقترحتها عليك.

حياك الله أخي ، رددت عليك بهذه المشاركة

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

هل هذه الرسالة لي؟

السنة الهجرية = (السنة الميلادية-622)/0.97 +1 622 هي السنة الميلادية لبداية التقويم الهجري 0.97 هي نسبة طول السنة الهجرية إلى طول السنة الميلادية 354.3667 / 365.2425 = 0.970223071 1 هو للزيادة سنة لما يسمى بالسنة الناقصة/غير المكتملة

جرب هذه المعادلة: (Date + 466581 - 0.53) / (10631 / 30) + 1

ما شاء الله ، شغل محترفين ، أهنئكم.

حياك الله أستاذ جعفر ، تحسين في الكود: Dim crl As Control On Error Resume Next For Each crl In Me.Controls With crl If Not Right(.Name, 2) Like "1[1-5]" Then Err.Clear .Value = "" If Err.Number <> 0 Then .Value = Date 'لا أنصح بهذا السطر End If End With Next crl

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