أبو هادي

السلام عليكم وجدت خطأين : الأول في دالة DateDiff2 وكان الخطأ في الأقواس والصواب كالتالي : Case "ww": DateDiff2 = Fix((Greg2 - Greg1) / 7) والآخر في دالة Month2 والخطأ في نسيان علامة التساوي والصواب كالتالي : Month2 = IIf(UmDate = "", 0, Mid(UmDate, 6, 2)) تحياتي .

السلام عليكم تم إعادة كتابة كل الدوال الخاصة بتقويم أم القرى ولم يتم فحص أي منها ، يعني تحتاج إلى فحص :d ماعدا دالة Format يبدو لي أنها ستأخد الجهد الأكبر لذا سأتركها للمستقبل القريب إن شاء الله تعالى . تحياتي . الملفات المرفقة UmAlQura_Functions_AboHadi.rar ( 2.74ك ) عدد مرات التنزيل: 14

السلام عليكم أعتقد أن مشكلتك هي عدم ترتيبك لحقل na . مرفق مثالكم بعد التعديل . تحياتي . m.rar

السلام عليكم مثال مرفق قديم تم التعديل عليه تستطيع التحكم فيه بعدد السجلات المراد تظليلها ويمكنك تظليل السجل الحالي ويحتوي كذلك على فكرة عمل مسلسل للنماذج أو الإستعلامات . هناك مشكلة عند تحويل النموذج إلى Data sheet واستخدام التنقل بين السجلات وخصوصا مع Page Dn و Page Up ولكن بما أن طلبك للنماذج المستمرة فلا مشكلة :( . تحياتي . CndFrmt.rar

السلام عليكم لم أستطع أن أكسر حماية مثال الأخ رضا عقيل . كما أن مثالي هو ما ذهب إليه الأخ مهند عبادي ولكن المشكلة ماذا لو عطلت الحدث كما حصل في حماية الأخ المزيني وقتها حيث كان كسر الحماية بتعطيل الحدث وبتصفير قيمة المؤقت . الآن المطلوب كيف يمكن أن أجبر البرنامج على تشغيل كود مع فتح البرنامج دون أن تعرضه للتعطيل ؟ على كل حال مثالي السابق بصيغة mdb بعد أن أحرق أخي مهند عبادي الفكرة . تحياتي . NewProtection-xp.rar

السلام عليكم حياك الله أخي أبوسليمان ، لم أقم بأي تعديلات عدا التي أشرت إليها وكل الذي عملته نسخ ولصق من ملف الـ bas وقد رجعت للملف الذي أرسلته لك وهو يحتوي على الأسطر التي أوضحت بعدم وجودها ، إلا إذا أرسلت لك ملف آخر بالخطأ .. ربما . على كل حال ملاحظتك تدل أنك فحصت ومحصت الكود (y) ، أتعبته وأتعبك :d ، فعلا هناك خطأ في المقارنة وتم تعديلها لتكن كالتالي : If yy > UBound(UmAll) And _ Days <= UmAll(UBound(UmAll)).GS + UmAll(UBound(UmAll)).M2(12) - 1 Then yy = yy - 1 End If تحياتي .

السلام عليكم هذه محاولة جديدة وبفكرة أسهل بكثير من سابقتها ، آمل تجربتها من الجميع . تحياتي . NewProtection-xp.rar

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

السلام عليكم أخي أبوسليمان .. لقد أرسلت المثال ويحتوي على تعليقاتي حول الإضافات وفكرة الكود الجديد . تحياتي .

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

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

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

السلام عليكم إذا كان المطلوب لنفس النموذج المرفق في مشاركة الأخ أبو نعيم فهذا الكود يفي بالغرض : Sub LaborIDSplit() Dim K As Byte Dim ID As String * 10 ID = Me.RecordsetClone!IDNo If Len(Trim(ID)) <> 10 Then Exit Sub ID = Trim(ID) For K = 1 To 10 Me("[ID" & K - 1 & "]") = Mid(ID, K, 1) Next K End Sub على أن يوضع في الموديول التابع للنموذج نفسه . تحياتي .

السلام عليكم تنقيح وتعديل في دالة تقسيم الأسماء وأهمها إزالة المسافات الزائدة حيث كانت تعطي نتائج خاطئة بسببها : Function LaborNameSplit(ByVal InName As String, PartNo As Byte) As String Dim FullName As String Dim Part As String Dim Part2 As String Dim LPart As String Dim Pos As Byte Dim Pos2 As Byte Dim K As Integer LaborNameSplit = "" FullName = Trim(Nz(InName)) & " " Do Pos = InStr(1, FullName, " ") If Pos > 0 Then FullName = Left(FullName, Pos) & Mid(FullName, Pos + 2) Loop Until Pos = 0 Do While True K = K + 1 Pos = InStr(1, FullName, " ") Part = Left(FullName, Pos) Select Case Part Case "آل ", "عبد ", "عبدرب ", "Al ", "Abdul " Pos = InStr(Pos + 1, FullName, " ") Case Else Pos2 = InStr(Pos + 1, FullName, " ") If Pos2 > 0 Then Part2 = Mid(FullName, Pos + 1, Pos2 - Pos) Select Case Part2 Case "الله ", "الحق ", "الإسلام ", "الدين " Pos = Pos2 End Select End If End Select If Pos = 0 Then If PartNo > 0 Then If (K - 1) = PartNo Then LaborNameSplit = "" Else LaborNameSplit = LPart End If Exit Function End If If K = PartNo Then LaborNameSplit = Left(FullName, Pos - 1) LPart = Left(FullName, Pos - 1) FullName = Mid(FullName, Pos + 1, Len(FullName)) Loop End Function تحياتي .

السلام عليكم 50 سنة إضافية من عام 1451 حتى عام 1500هـ . '-- السنوات من 1451 حتى 1500 من تقويم أبو هادي وقد تحتوي على بعض الإختلافات Case 1451: Call FillYear("14-05-2029", 1, 1, 0, 1, 0, 0, 1, 0, 1, 0, 1, 1) Case 1452: Call FillYear("04-05-2030", 0, 1, 1, 0, 1, 0, 0, 1, 0, 1, 0, 1) Case 1453: Call FillYear("23-04-2031", 0, 1, 1, 1, 0, 1, 0, 0, 1, 0, 1, 0) Case 1454: Call FillYear("11-04-2032", 0, 1, 1, 1, 0, 1, 0, 1, 0, 1, 0, 1) Case 1455: Call FillYear("01-04-2033", 0, 0, 1, 1, 0, 1, 0, 1, 1, 0, 1, 0) Case 1456: Call FillYear("21-03-2034", 1, 0, 0, 1, 0, 1, 0, 1, 1, 1, 0, 1) Case 1457: Call FillYear("11-03-2035", 0, 1, 0, 0, 1, 0, 0, 1, 1, 0, 1, 1) Case 1458: Call FillYear("28-02-2036", 1, 0, 1, 0, 0, 1, 0, 0, 1, 1, 0, 1) Case 1459: Call FillYear("16-02-2037", 1, 1, 0, 1, 0, 0, 1, 0, 0, 1, 1, 0) Case 1460: Call FillYear("05-02-2038", 1, 1, 0, 1, 0, 1, 0, 1, 0, 0, 1, 1) Case 1461: Call FillYear("26-01-2039", 0, 1, 0, 1, 1, 0, 1, 0, 1, 0, 1, 0) Case 1462: Call FillYear("15-01-2040", 1, 0, 1, 0, 1, 0, 1, 0, 1, 1, 0, 1) Case 1463: Call FillYear("04-01-2041", 0, 1, 0, 0, 1, 0, 1, 1, 0, 1, 1, 0) Case 1464: Call FillYear("24-12-2041", 1, 0, 1, 0, 0, 1, 0, 1, 0, 1, 1, 1) Case 1465: Call FillYear("14-12-2042", 0, 1, 0, 1, 0, 0, 1, 0, 0, 1, 1, 1) Case 1466: Call FillYear("03-12-2043", 1, 0, 1, 0, 1, 0, 0, 1, 0, 1, 0, 1) Case 1467: Call FillYear("21-11-2044", 1, 0, 1, 1, 0, 1, 0, 0, 1, 0, 1, 0) Case 1468: Call FillYear("10-11-2045", 1, 0, 1, 1, 0, 1, 0, 1, 0, 1, 0, 1) Case 1469: Call FillYear("31-10-2046", 0, 0, 1, 1, 0, 1, 1, 0, 1, 1, 0, 0) Case 1470: Call FillYear("20-10-2047", 1, 0, 0, 1, 1, 0, 1, 0, 1, 1, 1, 0) Case 1471: Call FillYear("09-10-2048", 0, 1, 0, 0, 1, 0, 1, 1, 0, 1, 1, 0) Case 1472: Call FillYear("28-09-2049", 1, 0, 1, 0, 1, 0, 0, 1, 0, 1, 1, 0) Case 1473: Call FillYear("17-09-2050", 1, 1, 0, 1, 0, 1, 0, 0, 1, 0, 1, 0) Case 1474: Call FillYear("06-09-2051", 1, 1, 0, 1, 1, 0, 1, 0, 0, 1, 0, 1) Case 1475: Call FillYear("26-08-2052", 0, 1, 0, 1, 1, 1, 0, 1, 0, 0, 1, 0) Case 1476: Call FillYear("15-08-2053", 0, 1, 0, 1, 1, 1, 0, 1, 1, 0, 0, 1) Case 1477: Call FillYear("05-08-2054", 0, 0, 1, 0, 1, 1, 0, 1, 1, 1, 0, 0) Case 1478: Call FillYear("25-07-2055", 1, 0, 0, 1, 0, 1, 1, 0, 1, 1, 0, 1) Case 1479: Call FillYear("14-07-2056", 0, 1, 0, 0, 1, 0, 1, 0, 1, 1, 0, 1) Case 1480: Call FillYear("03-07-2057", 0, 1, 1, 0, 1, 0, 0, 1, 0, 1, 0, 1) Case 1481: Call FillYear("22-06-2058", 0, 1, 1, 0, 1, 1, 0, 1, 0, 0, 1, 0) Case 1482: Call FillYear("11-06-2059", 1, 0, 1, 1, 0, 1, 1, 0, 1, 0, 0, 1) Case 1483: Call FillYear("31-05-2060", 0, 0, 1, 1, 0, 1, 1, 1, 0, 1, 0, 0) Case 1484: Call FillYear("20-05-2061", 1, 0, 0, 1, 1, 0, 1, 1, 0, 1, 1, 0) Case 1485: Call FillYear("10-05-2062", 0, 1, 0, 0, 1, 1, 0, 1, 1, 0, 1, 1) Case 1486: Call FillYear("30-04-2063", 0, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 1) Case 1487: Call FillYear("18-04-2064", 0, 1, 0, 1, 0, 1, 0, 0, 1, 0, 1, 1) Case 1488: Call FillYear("07-04-2065", 0, 1, 1, 0, 1, 0, 1, 0, 0, 1, 0, 1) Case 1489: Call FillYear("27-03-2066", 0, 1, 1, 0, 1, 1, 0, 1, 0, 0, 1, 1) Case 1490: Call FillYear("17-03-2067", 0, 0, 1, 1, 0, 1, 1, 0, 1, 0, 0, 1) Case 1491: Call FillYear("05-03-2068", 0, 1, 0, 1, 0, 1, 1, 0, 1, 0, 1, 1) Case 1492: Call FillYear("23-02-2069", 0, 0, 1, 0, 1, 0, 1, 0, 1, 1, 0, 1) Case 1493: Call FillYear("12-02-2070", 1, 0, 0, 1, 0, 1, 0, 0, 1, 1, 0, 1) Case 1494: Call FillYear("01-02-2071", 1, 1, 0, 0, 1, 0, 0, 1, 0, 1, 0, 1) Case 1495: Call FillYear("21-01-2072", 1, 1, 0, 1, 0, 1, 0, 0, 1, 0, 1, 0) Case 1496: Call FillYear("09-01-2073", 1, 1, 1, 0, 1, 0, 1, 0, 0, 1, 0, 1) Case 1497: Call FillYear("30-12-2073", 0, 1, 0, 1, 1, 1, 0, 0, 1, 0, 1, 0) Case 1498: Call FillYear("19-12-2074", 1, 0, 1, 0, 1, 1, 0, 1, 0, 1, 0, 1) Case 1499: Call FillYear("09-12-2075", 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 1, 0) Case 1500: Call FillYear("27-11-2076", 1, 1, 0, 0, 1, 0, 0, 1, 0, 1, 1, 1) على أن يعدل السطر التالي : LRec = 1500 تحياتي .

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

السلام عليكم أخي أبوسليمان حفظك الله الـ 50 سنة تلك هي من نتائج تقويمي الفلكي وليست من نتائج مدينة الملك عبدالعزيز للعلوم والتكنولوجيا . وكما أذكر أني أوضحت أن صحة البيانات تتجاوز الـ 99% ، ولكن لم أحصل على تأييد باستخدامها ولا أدري الآن أين أحتفظ بهذه النتائج ، ولكن إن رأيتم أن أبحث عنها بحثت ، وإلا فأني أرفق لكم برنامج احتساب الشهور الفلكية حسب مدينة أم القرى بلغة باسكال . تحياتي . الملفات المرفقة MOON2.rar ( 34.34ك ) عدد مرات التنزيل: 19

السلام عليكم هذه دالة لطلب أي جزء من الإسم حتى لو كان رقم 25 مثلا . أما في حالة طلب الإسم الأخير ولنعتبره اسم العائلة أو القبيلة فنستخدم رقم 0 ( صفر ) : Function LaborNameSplit(InName As String, PartNo As Byte) As String Dim FullName, Part, Part2, LPart As String Dim pos, Pos2 As Byte Dim K As Integer LaborNameSplit = "" FullName = RTrim(LTrim(Nz(InName))) & " " Do While True K = K + 1 pos = InStr(1, FullName, " ") Part = Left(FullName, pos) If Part = "آل " Or Part = "عبد " Or Part = "عبدرب " Or _ Part = "Al " Or Part = "Abdul " Then pos = InStr(pos + 1, FullName, " ") Else Pos2 = InStr(pos + 1, FullName, " ") If Pos2 > 0 Then Part2 = Mid(FullName, pos + 1, Pos2 - pos) Select Case Part2 Case "الله ", "الحق ", "الإسلام ", "الدين " pos = Pos2 End Select End If End If If pos = 0 Then Select Case PartNo Case Is > 0 If (K - 1) = PartNo Then LaborNameSplit = "" End If Case Else LaborNameSplit = LPart End Select Exit Function End If Select Case K Case PartNo LaborNameSplit = Left(FullName, pos - 1) End Select LPart = Left(FullName, pos - 1) FullName = Mid(FullName, pos + 1, Len(FullName)) Loop End Function واستدعاؤها كالتالي : Me.txtName = LaborNameSplit(Nz(ClientName), 1) Me.txtFather = LaborNameSplit(Nz(ClientName), 2) Me.txtGrand = LaborNameSplit(Nz(ClientName), 3) Me.txtFamily = LaborNameSplit(Nz(ClientName), 0) تحياتي .

السلام عليكم ما أوضحه الأستاذ مهند عبادي يكفي عدا أنه يحتاج تعديل التنسيق فقط ليكون كالتالي : Format([NumDate], "####/##/##") تحياتي .

السلام عليكم أنا صحيح كبرت وأصبحت أنسى كثيرا والسكري عبث في صحتي كثيرا ولكن لا زالت حواسي تعمل والحمد لله :d هذا الكود لاستيراد جدول من قاعدة بيانات أخرى حتى وإن كانت محمية بكلمة مرور ولكن بشرط أن يكون الجدول له رابط . وإذا لم يكن له رابط فسيضطر إلى إدخال كلمة السر عندما يطلبها إجراء فتح القاعدة الهدف . وهوطبعا ضمن المثال الذي ذكرته سابقا : Private Sub CmdTransferdatabase_Click() Dim SourceName As String Dim NewName As String Dim dbs As Database Dim obj As TableDef Dim DbsName As String Dim DbsPWD As String Dim Pos As Byte If NoTableNames Then Exit Sub SourceName = Me.OldTableName NewName = Me.NewTableName Set dbs = CurrentDb Set obj = dbs.TableDefs(SourceName) If obj.Connect = "" Then MsgBox "لا يمكن استيراد جدول من نفس القاعدة" Set dbs = Nothing Exit Sub End If DbsName = Mid(obj.Connect, InStr(1, obj.Connect, "DATABASE=") + 9) Pos = InStr(1, obj.Connect, "PWD=") If Pos > 0 Then DbsPWD = Mid(obj.Connect, Pos + 4, InStr(Pos + 1, obj.Connect, ";") - Pos - 4) SendKeys DbsPWD SendKeys "{Enter}" End If DoCmd.TransferDatabase acImport, "Microsoft Access", _ DbsName, acTable, obj.SourceTableName, NewName Set dbs = Nothing End Sub تحياتي .

السلام عليكم وجدت لكم من قديمي ملف عملته لأحد المحاسبين عندما كانت الرواتب وقتها تصرف نقدا ، وقد كان يواجه مشكلة في معرفة عدد ( الأوراق / البنك نوت ) من كل فئة . ويبدو أني عملته قبل استحداث فئة الـ 200 والـ 20 ريال . تحياتي . DENOMINATIONS.rar

السلام عليكم مثال آخر قد يفيدك : نسخ الجداول بثلاث طرق بالكود تحياتي .

السلام عليكم مرفق مثالك بعد التعديل . للتخلص من الفلترة انقري نقرا مزدوجا على الـ Combo . تحياتي . db1.rar

السلام عليكم مرفق مثال وهو يمثل نوع من أنواع الحلول الكثيرة ومنها ماذكره الإخوة قبلي . تحياتي . ClinicAppointments.rar

السلام عليكم الأخ عبدالله سليمان .. آمل تجربة تقويم أم القرى في بيئة التقويم الهجري وذلك بعد التعديلات التي وعدت بها : Option Explicit Type UmRec yy As Integer M2(0 To 12) As Integer GS As Long End Type Public UmAll() As UmRec Private Type YearData M(1 To 12) As Byte GS As Date End Type Private yy As YearData Function myNz(ByVal InValue, Optional ByVal ValueIfNull = Null) myNz = IIf(IsNull(InValue), IIf(IsNull(ValueIfNull), Empty, ValueIfNull), InValue) End Function Function HijriYear(ByVal dd As Byte, ByVal mm As Byte, yy As Integer) As Integer Dim CurrCal As Byte Dim GDate As Date CurrCal = Calendar Calendar = vbCalGreg GDate = DateSerial(yy, mm, dd) Calendar = vbCalHijri HijriYear = Year(GDate) Calendar = CurrCal End Function Private Sub FillYear( _ ByVal GS As String, _ ByVal M1 As Byte, _ ByVal M2 As Byte, _ ByVal M3 As Byte, _ ByVal M4 As Byte, _ ByVal M5 As Byte, _ ByVal M6 As Byte, _ ByVal M7 As Byte, _ ByVal M8 As Byte, _ ByVal M9 As Byte, _ ByVal M10 As Byte, _ ByVal M11 As Byte, _ ByVal M12 As Byte) Dim CurrCal As Byte CurrCal = Calendar Calendar = vbCalGreg yy.GS = DateSerial(Right(GS, 4), Mid(GS, 4, 2), Left(GS, 2)) yy.M(1) = M1 yy.M(2) = M2 yy.M(3) = M3 yy.M(4) = M4 yy.M(5) = M5 yy.M(6) = M6 yy.M(7) = M7 yy.M(8) = M8 yy.M(9) = M9 yy.M(10) = M10 yy.M(11) = M11 yy.M(12) = M12 Calendar = CurrCal End Sub Public Sub LoadYearData(ByVal yy As Integer) Select Case yy Case 1300: Call FillYear("11-11-1882", 1, 1, 0, 1, 0, 0, 1, 0, 1, 0, 1, 0) Case 1301: Call FillYear("31-10-1883", 1, 1, 1, 0, 1, 0, 0, 1, 0, 0, 1, 1) Case 1302: Call FillYear("20-10-1884", 0, 1, 1, 1, 0, 1, 0, 0, 1, 0, 0, 1) Case 1303: Call FillYear("09-10-1885", 0, 1, 1, 1, 0, 1, 1, 0, 0, 1, 0, 0) Case 1304: Call FillYear("28-09-1886", 1, 0, 1, 1, 0, 1, 1, 0, 1, 0, 1, 0) Case 1305: Call FillYear("18-09-1887", 0, 1, 0, 1, 0, 1, 1, 1, 0, 1, 0, 1) Case 1306: Call FillYear("07-09-1888", 0, 1, 0, 0, 1, 0, 1, 1, 0, 1, 1, 0) Case 1307: Call FillYear("27-08-1889", 1, 0, 1, 0, 0, 1, 0, 1, 0, 1, 1, 0) Case 1308: Call FillYear("16-08-1890", 1, 0, 1, 1, 0, 1, 0, 0, 1, 0, 1, 0) Case 1309: Call FillYear("05-08-1891", 1, 1, 0, 1, 1, 0, 1, 0, 0, 1, 0, 0) Case 1310: Call FillYear("24-07-1892", 1, 1, 0, 1, 1, 1, 0, 1, 0, 0, 1, 0) Case 1311: Call FillYear("14-07-1893", 0, 1, 0, 1, 1, 1, 0, 1, 1, 0, 0, 1) Case 1312: Call FillYear("04-07-1894", 0, 0, 1, 0, 1, 1, 0, 1, 1, 1, 0, 0) Case 1313: Call FillYear("23-06-1895", 1, 0, 0, 1, 0, 1, 0, 1, 1, 1, 0, 1) Case 1314: Call FillYear("12-06-1896", 0, 1, 0, 0, 1, 0, 1, 0, 1, 1, 0, 1) Case 1315: Call FillYear("01-06-1897", 1, 0, 1, 0, 0, 1, 0, 1, 0, 1, 0, 1) Case 1316: Call FillYear("21-05-1898", 1, 0, 1, 1, 0, 1, 0, 0, 1, 0, 1, 0) Case 1317: Call FillYear("10-05-1899", 1, 0, 1, 1, 0, 1, 1, 0, 1, 0, 0, 1) Case 1318: Call FillYear("30-04-1900", 0, 1, 0, 1, 0, 1, 1, 1, 0, 1, 0, 0) Case 1319: Call FillYear("19-04-1901", 1, 0, 0, 1, 0, 1, 1, 1, 0, 1, 1, 0) Case 1320: Call FillYear("09-04-1902", 0, 1, 0, 0, 1, 0, 1, 1, 0, 1, 1, 1) Case 1321: Call FillYear("30-03-1903", 0, 0, 1, 0, 0, 1, 0, 1, 0, 1, 1, 1) Case 1322: Call FillYear("18-03-1904", 0, 1, 0, 1, 0, 0, 1, 0, 1, 0, 1, 1) Case 1323: Call FillYear("07-03-1905", 0, 1, 1, 0, 1, 0, 0, 1, 0, 1, 0, 1) Case 1324: Call FillYear("24-02-1906", 0, 1, 1, 0, 1, 1, 0, 0, 1, 0, 1, 0) Case 1325: Call FillYear("13-02-1907", 1, 0, 1, 0, 1, 1, 0, 1, 0, 1, 0, 1) Case 1326: Call FillYear("03-02-1908", 0, 1, 0, 1, 0, 1, 0, 1, 1, 0, 1, 1) Case 1327: Call FillYear("23-01-1909", 0, 0, 1, 0, 0, 1, 0, 1, 1, 1, 0, 1) Case 1328: Call FillYear("12-01-1910", 1, 0, 0, 1, 0, 0, 1, 0, 1, 1, 0, 1) Case 1329: Call FillYear("01-01-1911", 1, 1, 0, 0, 1, 0, 0, 1, 0, 1, 0, 1) Case 1330: Call FillYear("21-12-1911", 1, 1, 0, 1, 0, 1, 0, 0, 1, 0, 1, 0) Case 1331: Call FillYear("09-12-1912", 1, 1, 1, 0, 1, 0, 1, 0, 0, 1, 0, 1) Case 1332: Call FillYear("29-11-1913", 0, 1, 1, 0, 1, 1, 0, 1, 0, 0, 1, 0) Case 1333: Call FillYear("18-11-1914", 1, 0, 1, 0, 1, 1, 0, 1, 0, 1, 0, 1) Case 1334: Call FillYear("08-11-1915", 0, 1, 0, 1, 0, 1, 0, 1, 1, 0, 1, 0) Case 1335: Call FillYear("27-10-1916", 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 1) Case 1336: Call FillYear("17-10-1917", 0, 1, 0, 1, 0, 1, 0, 0, 1, 0, 1, 1) Case 1337: Call FillYear("06-10-1918", 0, 1, 1, 0, 1, 0, 1, 0, 0, 1, 0, 1) Case 1338: Call FillYear("25-09-1919", 0, 1, 1, 1, 0, 1, 0, 1, 0, 0, 1, 0) Case 1339: Call FillYear("13-09-1920", 1, 0, 1, 1, 1, 0, 1, 0, 1, 0, 0, 1) Case 1340: Call FillYear("03-09-1921", 0, 0, 1, 1, 0, 1, 1, 1, 0, 1, 0, 0) Case 1341: Call FillYear("23-08-1922", 1, 0, 1, 0, 1, 0, 1, 1, 0, 1, 1, 0) Case 1342: Call FillYear("13-08-1923", 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 1, 0) Case 1343: Call FillYear("01-08-1924", 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0) Case 1344: Call FillYear("21-07-1925", 1, 1, 0, 1, 0, 1, 0, 1, 0, 0, 1, 0) Case 1345: Call FillYear("10-07-1926", 1, 1, 0, 1, 1, 0, 1, 0, 1, 0, 0, 1) Case 1346: Call FillYear("30-06-1927", 0, 1, 0, 1, 1, 1, 0, 1, 0, 1, 0, 0) Case 1347: Call FillYear("18-06-1928", 1, 0, 1, 0, 1, 1, 1, 0, 1, 0, 1, 0) Case 1348: Call FillYear("08-06-1929", 0, 1, 0, 0, 1, 1, 0, 1, 1, 1, 0, 1) Case 1349: Call FillYear("29-05-1930", 0, 0, 1, 0, 0, 1, 1, 0, 1, 1, 1, 0) Case 1350: Call FillYear("18-05-1931", 1, 0, 0, 1, 0, 0, 1, 0, 1, 1, 1, 0) Case 1351: Call FillYear("06-05-1932", 1, 0, 1, 0, 1, 0, 1, 0, 0, 1, 1, 0) Case 1352: Call FillYear("25-04-1933", 1, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 0) Case 1353: Call FillYear("14-04-1934", 1, 1, 0, 1, 1, 0, 1, 0, 1, 0, 1, 0) Case 1354: Call FillYear("04-04-1935", 0, 1, 0, 1, 1, 0, 1, 1, 0, 1, 0, 1) Case 1355: Call FillYear("24-03-1936", 0, 0, 1, 0, 1, 0, 1, 1, 0, 1, 1, 0) Case 1356: Call FillYear("13-03-1937", 1, 0, 0, 1, 0, 0, 1, 1, 0, 1, 1, 1) Case 1357: Call FillYear("03-03-1938", 0, 1, 0, 0, 1, 0, 0, 1, 1, 0, 1, 1) Case 1358: Call FillYear("20-02-1939", 1, 0, 1, 0, 0, 1, 0, 0, 1, 0, 1, 1) Case 1359: Call FillYear("09-02-1940", 1, 0, 1, 1, 0, 0, 1, 0, 0, 1, 0, 1) Case 1360: Call FillYear("28-01-1941", 1, 0, 1, 1, 0, 1, 0, 1, 0, 1, 0, 0) Case 1361: Call FillYear("17-01-1942", 1, 0, 1, 1, 0, 1, 1, 0, 1, 0, 1, 0) Case 1362: Call FillYear("07-01-1943", 0, 1, 0, 1, 0, 1, 1, 0, 1, 1, 0, 1) Case 1363: Call FillYear("28-12-1943", 0, 1, 0, 0, 1, 0, 1, 0, 1, 1, 0, 1) Case 1364: Call FillYear("16-12-1944", 1, 0, 1, 0, 0, 1, 0, 1, 0, 1, 0, 1) Case 1365: Call FillYear("05-12-1945", 1, 1, 0, 1, 0, 0, 1, 0, 0, 1, 0, 1) Case 1366: Call FillYear("24-11-1946", 1, 1, 1, 0, 1, 0, 0, 1, 0, 0, 1, 0) Case 1367: Call FillYear("13-11-1947", 1, 1, 1, 0, 1, 1, 0, 0, 1, 0, 0, 1) Case 1368: Call FillYear("02-11-1948", 0, 1, 1, 0, 1, 1, 0, 1, 0, 1, 0, 0) Case 1369: Call FillYear("22-10-1949", 1, 0, 1, 0, 1, 1, 1, 0, 1, 0, 1, 0) Case 1370: Call FillYear("12-10-1950", 0, 1, 0, 1, 0, 1, 1, 0, 1, 0, 1, 1) Case 1371: Call FillYear("02-10-1951", 0, 1, 0, 0, 1, 0, 1, 0, 1, 0, 1, 1) Case 1372: Call FillYear("20-09-1952", 0, 1, 1, 0, 1, 0, 0, 1, 0, 1, 0, 1) Case 1373: Call FillYear("09-09-1953", 1, 0, 1, 1, 0, 1, 0, 0, 1, 0, 0, 1) Case 1374: Call FillYear("29-08-1954", 1, 0, 1, 1, 1, 0, 1, 0, 0, 1, 0, 0) Case 1375: Call FillYear("18-08-1955", 1, 0, 1, 1, 1, 0, 1, 1, 0, 0, 1, 0) Case 1376: Call FillYear("07-08-1956", 0, 1, 0, 1, 1, 0, 1, 1, 0, 1, 0, 1) Case 1377: Call FillYear("28-07-1957", 0, 0, 1, 0, 1, 0, 1, 1, 1, 0, 1, 0) Case 1378: Call FillYear("17-07-1958", 1, 0, 0, 1, 0, 1, 0, 1, 1, 0, 1, 1) Case 1379: Call FillYear("07-07-1959", 0, 1, 0, 0, 1, 0, 1, 0, 1, 0, 1, 1) Case 1380: Call FillYear("25-06-1960", 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1) Case 1381: Call FillYear("14-06-1961", 0, 1, 1, 0, 1, 0, 1, 1, 0, 0, 1, 0) Case 1382: Call FillYear("03-06-1962", 0, 1, 1, 0, 1, 1, 0, 1, 1, 0, 0, 1) Case 1383: Call FillYear("24-05-1963", 0, 0, 1, 0, 1, 1, 1, 0, 1, 1, 0, 0) Case 1384: Call FillYear("12-05-1964", 1, 0, 0, 1, 0, 1, 1, 0, 1, 1, 1, 0) Case 1385: Call FillYear("02-05-1965", 0, 1, 0, 0, 1, 0, 1, 0, 1, 1, 1, 0) Case 1386: Call FillYear("21-04-1966", 1, 0, 1, 0, 0, 1, 0, 1, 0, 1, 1, 0) Case 1387: Call FillYear("10-04-1967", 1, 1, 0, 1, 0, 0, 1, 0, 1, 0, 1, 0) Case 1388: Call FillYear("29-03-1968", 1, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1) Case 1389: Call FillYear("19-03-1969", 0, 1, 0, 1, 1, 0, 1, 0, 1, 0, 1, 0) Case 1390: Call FillYear("08-03-1970", 1, 0, 1, 0, 1, 0, 1, 1, 0, 1, 0, 1) Case 1391: Call FillYear("26-02-1971", 0, 1, 0, 0, 1, 0, 1, 1, 1, 0, 1, 1) Case 1392: Call FillYear("16-02-1972", 0, 0, 1, 0, 0, 1, 0, 1, 1, 0, 1, 1) Case 1393: Call FillYear("04-02-1973", 1, 0, 0, 1, 0, 0, 1, 0, 1, 0, 1, 1) Case 1394: Call FillYear("24-01-1974", 1, 0, 1, 0, 1, 0, 0, 1, 0, 1, 0, 1) Case 1395: Call FillYear("13-01-1975", 1, 0, 1, 1, 0, 1, 0, 0, 1, 0, 1, 0) Case 1396: Call FillYear("02-01-1976", 1, 0, 1, 1, 1, 0, 1, 0, 0, 1, 0, 1) Case 1397: Call FillYear("22-12-1976", 0, 1, 0, 1, 1, 0, 1, 0, 1, 0, 1, 0) Case 1398: Call FillYear("11-12-1977", 1, 0, 1, 0, 1, 0, 1, 1, 0, 1, 0, 1) Case 1399: Call FillYear("01-12-1978", 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 1, 0) Case 1400: Call FillYear("20-11-1979", 1, 0, 1, 0, 1, 0, 0, 1, 0, 1, 1, 0) Case 1401: Call FillYear("08-11-1980", 1, 1, 0, 1, 0, 1, 0, 0, 1, 0, 1, 0) Case 1402: Call FillYear("28-10-1981", 1, 1, 1, 0, 1, 0, 1, 0, 0, 1, 0, 1) Case 1403: Call FillYear("18-10-1982", 0, 1, 1, 1, 0, 1, 0, 1, 0, 0, 1, 0) Case 1404: Call FillYear("07-10-1983", 0, 1, 1, 0, 1, 1, 1, 0, 1, 0, 0, 1) Case 1405: Call FillYear("26-09-1984", 0, 0, 1, 1, 0, 1, 1, 0, 1, 0, 1, 0) Case 1406: Call FillYear("15-09-1985", 1, 0, 1, 0, 1, 0, 1, 0, 1, 1, 0, 1) Case 1407: Call FillYear("05-09-1986", 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1) Case 1408: Call FillYear("25-08-1987", 1, 0, 1, 0, 1, 0, 1, 0, 0, 1, 0, 1) Case 1409: Call FillYear("13-08-1988", 1, 0, 1, 1, 0, 1, 0, 1, 0, 0, 1, 0) Case 1410: Call FillYear("02-08-1989", 1, 0, 1, 1, 1, 0, 1, 0, 1, 0, 0, 1) Case 1411: Call FillYear("23-07-1990", 0, 1, 0, 1, 1, 0, 1, 1, 0, 1, 0, 0) Case 1412: Call FillYear("12-07-1991", 1, 0, 0, 1, 1, 0, 1, 1, 1, 0, 1, 0) Case 1413: Call FillYear("01-07-1992", 0, 1, 0, 0, 1, 1, 0, 1, 1, 0, 1, 1) Case 1414: Call FillYear("21-06-1993", 0, 0, 1, 0, 0, 1, 0, 1, 1, 1, 0, 1) Case 1415: Call FillYear("10-06-1994", 0, 1, 0, 1, 0, 0, 1, 0, 1, 1, 0, 1) Case 1416: Call FillYear("30-05-1995", 1, 0, 1, 0, 1, 0, 1, 0, 0, 1, 0, 1) Case 1417: Call FillYear("18-05-1996", 1, 0, 1, 0, 1, 1, 0, 1, 0, 1, 0, 0) Case 1418: Call FillYear("07-05-1997", 1, 0, 1, 0, 1, 1, 1, 0, 1, 0, 1, 0) Case 1419: Call FillYear("27-04-1998", 0, 1, 0, 1, 0, 1, 1, 0, 1, 1, 0, 1) Case 1420: Call FillYear("17-04-1999", 0, 1, 0, 0, 1, 0, 1, 1, 1, 1, 0, 1) Case 1421: Call FillYear("06-04-2000", 0, 0, 1, 0, 0, 0, 1, 1, 1, 1, 0, 1) Case 1422: Call FillYear("26-03-2001", 1, 0, 0, 1, 0, 0, 0, 1, 1, 1, 0, 1) Case 1423: Call FillYear("15-03-2002", 1, 0, 1, 0, 1, 0, 0, 1, 0, 1, 0, 1) Case 1424: Call FillYear("04-03-2003", 1, 0, 1, 1, 0, 1, 0, 0, 1, 0, 1, 0) Case 1425: Call FillYear("21-02-2004", 1, 0, 1, 1, 0, 1, 0, 1, 1, 0, 1, 0) Case 1426: Call FillYear("10-02-2005", 0, 1, 0, 1, 0, 1, 1, 0, 1, 1, 0, 1) Case 1427: Call FillYear("31-01-2006", 0, 0, 1, 0, 1, 0, 1, 1, 0, 1, 1, 0) Case 1428: Call FillYear("20-01-2007", 1, 0, 0, 1, 0, 0, 1, 1, 1, 0, 1, 1) Case 1429: Call FillYear("10-01-2008", 0, 1, 0, 0, 1, 0, 0, 1, 1, 0, 1, 1) Case 1430: Call FillYear("29-12-2008", 0, 1, 1, 0, 0, 1, 0, 1, 0, 1, 0, 1) Case 1431: Call FillYear("18-12-2009", 0, 1, 1, 0, 1, 0, 1, 0, 1, 0, 0, 1) Case 1432: Call FillYear("07-12-2010", 0, 1, 1, 1, 0, 1, 0, 1, 0, 1, 0, 0) Case 1433: Call FillYear("26-11-2011", 1, 0, 1, 1, 0, 1, 1, 0, 1, 0, 1, 0) Case 1434: Call FillYear("15-11-2012", 0, 1, 0, 1, 0, 1, 1, 0, 1, 1, 0, 0) Case 1435: Call FillYear("04-11-2013", 1, 0, 1, 0, 1, 0, 1, 0, 1, 1, 0, 1) Case 1436: Call FillYear("25-10-2014", 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1) Case 1437: Call FillYear("14-10-2015", 1, 0, 1, 1, 0, 0, 1, 0, 1, 0, 0, 1) Case 1438: Call FillYear("02-10-2016", 1, 0, 1, 1, 1, 0, 0, 1, 0, 0, 1, 0) Case 1439: Call FillYear("21-09-2017", 1, 0, 1, 1, 1, 0, 1, 0, 1, 0, 0, 1) Case 1440: Call FillYear("11-09-2018", 0, 1, 0, 1, 1, 1, 0, 1, 0, 1, 0, 0) Case 1441: Call FillYear("31-08-2019", 1, 0, 1, 0, 1, 1, 0, 1, 1, 0, 1, 0) Case 1442: Call FillYear("20-08-2020", 0, 1, 0, 1, 0, 1, 0, 1, 1, 0, 1, 0) Case 1443: Call FillYear("09-08-2021", 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 1) Case 1444: Call FillYear("30-07-2022", 0, 1, 0, 1, 1, 0, 0, 1, 0, 1, 0, 1) Case 1445: Call FillYear("19-07-2023", 0, 1, 1, 1, 0, 1, 0, 0, 1, 0, 0, 1) Case 1446: Call FillYear("07-07-2024", 0, 1, 1, 1, 0, 1, 1, 0, 0, 1, 0, 0) Case 1447: Call FillYear("26-06-2025", 1, 0, 1, 1, 1, 0, 1, 0, 1, 0, 1, 0) Case 1448: Call FillYear("16-06-2026", 0, 1, 0, 1, 1, 0, 1, 1, 0, 1, 0, 1) Case 1449: Call FillYear("06-06-2027", 0, 0, 1, 0, 1, 0, 1, 1, 0, 1, 1, 0) Case 1450: Call FillYear("25-05-2028", 1, 0, 1, 0, 0, 1, 0, 1, 0, 1, 1, 0) End Select End Sub Sub LoadUmAlQura_Code() Const hmd = 29 Dim mm As Byte Dim HY As Long Dim Days As Long Dim FRec As Long Dim LRec As Long Dim Test As Variant On Error Resume Next Test = LBound(UmAll) If Err.number = 0 Then Exit Sub FRec = 1300 LRec = 1450 ReDim Preserve UmAll(FRec To LRec) As UmRec For HY = FRec To LRec Call LoadYearData(HY) UmAll(HY).yy = HY UmAll(HY).GS = yy.GS Days = 0 For mm = 1 To 12 Days = Days + yy.M(mm) + hmd UmAll(HY).M2(mm) = Days Next mm Next HY End Sub Function Greg2Um(ByVal dd As Byte, ByVal mm As Byte, ByVal yy As Integer) As Variant Dim K As Byte Dim HD2 As Integer Dim HM2 As Integer Dim HY2 As Integer Dim MDays As Integer Dim InDays As Long Dim Days As Variant Dim Hijri As String Dim Test As Variant Dim CurrCal As Byte On Error Resume Next CurrCal = Calendar Calendar = vbCalGreg Call LoadUmAlQura_Code Greg2Um = Null If Not IsDate(DateSerial(yy, mm, dd)) Then GoTo ExitFunction Days = DateSerial(yy, mm, dd) InDays = Days yy = HijriYear(dd, mm, yy) If yy > UBound(UmAll) And _ Days <= UmAll(UBound(UmAll)).GS + UmAll(UBound(UmAll)).M2(12) Then yy = yy - 1 End If Days = Null Days = CLng(UmAll(yy).GS) If IsNull(Days) Then GoTo ExitFunction If (InDays < Days) Or (InDays > (Days + UmAll(yy).M2(12) - 1)) Then If InDays < Days Then yy = yy - 1 Else yy = yy + 1 End If If yy >= LBound(UmAll) Or yy <= UBound(UmAll) Then Days = UmAll(yy).GS If IsNull(Days) Then GoTo ExitFunction Days = InDays - Days + 1 For K = 0 To 11 If UmAll(yy).M2(K + 1) > Days - 1 Then Exit For Next K dd = Days - UmAll(yy).M2(K) mm = K + 1 Greg2Um = Format(dd, "00") & "/" & Format(mm, "00") & "/" & Format(yy, "0000") End If ExitFunction: Calendar = CurrCal End Function Function Um2Greg(ByVal dd As Byte, ByVal mm As Byte, ByVal yy As Integer) As Variant Dim Days As Variant On Error Resume Next Call LoadUmAlQura_Code Um2Greg = Null Days = Null Days = UmAll(yy).GS If IsNull(Days) Then Exit Function Um2Greg = Days + UmAll(yy).M2(mm - 1) + dd - 1 End Function Function IsUmAlQura(ByVal dd As Byte, ByVal mm As Byte, ByVal yy As Integer) As Boolean Dim Greg As Variant Dim Hijri As Variant Dim d As Byte Dim M As Byte Dim Y As Integer Dim CurrCal As Byte CurrCal = Calendar Calendar = vbCalGreg Call LoadUmAlQura_Code Greg = CDate(myNz(Um2Greg(dd, mm, yy))) If IsDate(Greg) Then d = Day(Greg) M = Month(Greg) Y = Year(Greg) End If Hijri = Greg2Um(d, M, Y) If Not IsNull(Hijri) Then d = Val(Left(Hijri, 2)) M = Val(Mid(Hijri, 4, 2)) Y = Val(Right(Hijri, 4)) End If IsUmAlQura = (d = dd) And (M = mm) And (Y = yy) Calendar = CurrCal End Function Function UmMonthDays(ByVal mm As Byte, ByVal yy As Integer) As Byte Do While mm < 1: mm = mm + 12: yy = yy - 1: Loop Do While mm > 12: mm = mm - 12: yy = yy + 1: Loop Call LoadUmAlQura_Code If yy < LBound(UmAll) Or yy > UBound(UmAll) Then Exit Function UmMonthDays = UmAll(yy).M2(mm) - UmAll(yy).M2(mm - 1) End Function Function Hijri2Text(Hijri As String, Lang As Byte) As String Const vArabic = 1 Const vEnglish = 2 Dim Pos As Byte Dim dd As String Dim mm As String Dim yy As String Pos = InStr(1, Hijri, "/") Select Case Pos Case 3 dd = Left(Hijri, 2) mm = Mid(Hijri, 4, 2) yy = Mid(Hijri, 7, 4) Case 5 dd = Mid(Hijri, 9, 2) mm = Mid(Hijri, 6, 2) yy = Left(Hijri, 4) Case Else Hijri2Text = "" Exit Function End Select Select Case Lang Case vArabic Hijri2Text = yy & mm & dd Case vEnglish Hijri2Text = dd & mm & yy End Select End Function Function Hijri_Arabic(ByVal inHijri As String) As String Dim Hijri As String Hijri = Hijri2Text(inHijri, 1) Hijri_Arabic = Left(Hijri, 4) & "/" & Mid(Hijri, 5, 2) & "/" & Right(Hijri, 2) End Function تحياتي .