البحث في الموقع

السلام عليكم ورحمة الله تعالى وبركاته تحية طيبة عطرة موديول واحد قمت بتجميع الدوال الهامة للتاريخ بحيث يسهل استخدامها مع الاخذ فى الاعتبار بمرونة التحكم الشامل فى كل كبيرة وصغيره بسم الله الرحمن الرحيم وعلى بركة الله طالما سوف نتطرق الى التاريخ والتعامل معه لابد أن نبدأ على خطى استاذى الجليل و معلمى القدير و والدى الحبيب الاستاذ @jjafferr واقتبس من استاذى الجليل تلك الكلمات التى لابد ان تعلق فى اذهان كل من يتعامل مع دوال والتاريخ الروتين رقم 1 DateFormat Function DateFormat(ByVal varDate As Variant) As String 'Purpose: Return a delimited string in the date format used natively by JET SQL. 'Argument: A date/time value. 'Note: Returns just the date format if the argument has no time component, ' or a date/time format if it does. 'Author: Allen Browne. allen@allenbrowne.com, June 2006. ' 'calling the Function: DateFormat(The_Date_Field) 'a = dlookup("[some field]","some table","[id]=" & me.id & " And [Date_Field]=" & DateFormat(The_Date_Field)) ' If IsDate(varDate) Then If DateValue(varDate) = varDate Then DateFormat = Format$(varDate, "\#mm\/dd\/yyyy\#") Else DateFormat = Format$(varDate, "\#mm\/dd\/yyyy hh\:nn\:ss\#") End If End If End Function الروتين رقم 2 ToWhat يقوم بعمل التحويل من التاريخ الميلادى الى الهجرى والعكس ولكن لابد من عمل جدول باسم tblAdjustHjriDate يحتوى على حقل رقمى باسم AdjustDay وذلك لوضع الفرق بالايام بين التاريخين حسب كل شهر للحصول على النتيجة الصحيحة ' ______ ______ .__ __. ____ ____ _______ .______ .___________. __ .__ __. _______ ' / | / __ \ | \ | | \ \ / / | ____|| _ \ | || | | \ | | / _____| ' | ,----'| | | | | \| | \ \/ / | |__ | |_) | `---| |----`| | | \| | | | __ ' | | | | | | | . ` | \ / | __| | / | | | | | . ` | | | |_ | ' | `----.| `--' | | |\ | \ / | |____ | |\ \----. | | | | | |\ | | |__| | ' \______| \______/ |__| \__| \__/ |_______|| _| `._____| |__| |__| |__| \__| \______| ' _______ ___ .___________. _______ _______ .______ ______ .___ ___. ' | \ / \ | || ____| | ____|| _ \ / __ \ | \/ | ' | .--. | / ^ \ `---| |----`| |__ | |__ | |_) | | | | | | \ / | ' | | | | / /_\ \ | | | __| | __| | / | | | | | |\/| | ' | '--' | / _____ \ | | | |____ | | | |\ \----.| `--' | | | | | ' |_______/ /__/ \__\ |__| |_______| |__| | _| `._____| \______/ |__| |__| ' _______ .______ _______ _______ ______ .______ __ ___ .__ __. .___________. ______ ' / _____|| _ \ | ____| / _____| / __ \ | _ \ | | / \ | \ | | | | / __ \ ' | | __ | |_) | | |__ | | __ | | | | | |_) | | | / ^ \ | \| | `---| |----`| | | | ' | | |_ | | / | __| | | |_ | | | | | | / | | / /_\ \ | . ` | | | | | | | ' | |__| | | |\ \----.| |____ | |__| | | `--' | | |\ \----.| | / _____ \ | |\ | | | | `--' | ' \______| | _| `._____||_______| \______| \______/ | _| `._____||__| /__/ \__\ |__| \__| |__| \______/ ' __ __ __ __ .______ __ ' | | | | | | | | | _ \ | | ' | |__| | | | | | | |_) | | | ' | __ | | | .--. | | | / | | ' | | | | | | | `--' | | |\ \----.| | ' |__| |__| |__| \______/ | _| `._____||__| ' ______ .______ .______ ___ ______ __ ___ ' / __ \ | _ \ | _ \ / \ / || |/ / ' | | | | | |_) | | |_) | / ^ \ | ,----'| ' / ' | | | | | / | _ < / /_\ \ | | | < ' | `--' | | |\ \----. | |_) | / _____ \ | `----.| . \ ' \______/ | _| `._____| |______/ /__/ \__\ \______||__|\__\ ' Public Function ToWhat(ByRef myData As String, To_Hijri_Milady As String) As String Dim CorctAdjustDay As Integer Dim SavedCal As Integer Dim strD As Date Dim strS As String On Error GoTo ErrorHandler 'to call the Function 'Hijri to Milady 'txt Milady date = ToWhat(txt Hijri date, "H") 'Milady to Hijri 'txt Hijri date = ToWhat(txt Milady date, "M") CorctAdjustDay = DLookup("[AdjustDay]", "tblAdjustHjriDate") If To_Hijri_Milady = "M" Then myData = Trim(Format(DateAdd("d", -1 * CorctAdjustDay, myData), "dd/mm/yyyy")) SavedCal = Calendar VBA.Calendar = 1 strD = CDate(myData) VBA.Calendar = 0 Else myData = Trim(Format(DateAdd("d", CorctAdjustDay, myData), "dd/mm/yyyy")) SavedCal = Calendar VBA.Calendar = 0 strD = CDate(myData) VBA.Calendar = 1 End If strS = CStr(strD) ToWhat = Format(strS, "dd/mm/yyyy") VBA.Calendar = SavedCal ErrorHandlerExit: Exit Function ErrorHandler: If Err = 13 Then MsgBox "Wrong Data", vbOKOnly + vbMsgBoxRight + vbMsgBoxRtlReading, "Wrong" Exit Function 'Resume Next Else Resume ErrorHandlerExit End If End Function الروتين رقم 3 MyNo للتحكم فى شكل ظهور الارقام بالعربية او بالهندية من خلال استخدام اليونيكود ' __ ___ .__ __. _______ __ __ ___ _______ _______ ______ _______ .__ __. __ __ .___ ___. .______ _______ .______ _______. ' | | / \ | \ | | / _____|| | | | / \ / _____|| ____| / __ \ | ____| | \ | | | | | | | \/ | | _ \ | ____|| _ \ / | ' | | / ^ \ | \| | | | __ | | | | / ^ \ | | __ | |__ | | | | | |__ | \| | | | | | | \ / | | |_) | | |__ | |_) | | (----` ' | | / /_\ \ | . ` | | | |_ | | | | | / /_\ \ | | |_ | | __| | | | | | __| | . ` | | | | | | |\/| | | _ < | __| | / \ \ ' | `----. / _____ \ | |\ | | |__| | | `--' | / _____ \ | |__| | | |____ | `--' | | | | |\ | | `--' | | | | | | |_) | | |____ | |\ \----..----) | ' |_______|/__/ \__\ |__| \__| \______| \______/ /__/ \__\ \______| |_______| \______/ |__| |__| \__| \______/ |__| |__| |______/ |_______|| _| `._____||_______/ ' Public Function MyNo(ByVal strNo As String, ByVal strLng As String) 'to call the Function 'To Arabic 'txtNoToAR=MyNo(txtNo,"Ar") 'To English 'txtNoTOEng=MyNo(txtNo,"En") If strLng = "Ar" Then strNo = Replace(strNo, ChrW(48), ChrW(1632)) strNo = Replace(strNo, ChrW(49), ChrW(1633)) strNo = Replace(strNo, ChrW(50), ChrW(1634)) strNo = Replace(strNo, ChrW(51), ChrW(1635)) strNo = Replace(strNo, ChrW(52), ChrW(1636)) strNo = Replace(strNo, ChrW(53), ChrW(1637)) strNo = Replace(strNo, ChrW(54), ChrW(1638)) strNo = Replace(strNo, ChrW(55), ChrW(1639)) strNo = Replace(strNo, ChrW(56), ChrW(1640)) strNo = Replace(strNo, ChrW(57), ChrW(1641)) MyNo = strNo ElseIf strLng = "En" Then strNo = Replace(strNo, ChrW(1632), ChrW(48)) strNo = Replace(strNo, ChrW(1633), ChrW(49)) strNo = Replace(strNo, ChrW(1634), ChrW(50)) strNo = Replace(strNo, ChrW(1635), ChrW(51)) strNo = Replace(strNo, ChrW(1636), ChrW(52)) strNo = Replace(strNo, ChrW(1637), ChrW(53)) strNo = Replace(strNo, ChrW(1638), ChrW(54)) strNo = Replace(strNo, ChrW(1639), ChrW(55)) strNo = Replace(strNo, ChrW(1640), ChrW(56)) strNo = Replace(strNo, ChrW(1641), ChrW(57)) MyNo = strNo End If End Function الروتين رقم 4 MnthName اسماء الشهور الهجرى - العربى( الميلادى) - الانجليزيى( الميلادى) - اختصارالانجليزيى( الميلادى) - القبطى - السريانى ' .__ __. ___ .___ ___. _______ _______. ______ _______ .___________. __ __ _______ .___ ___. ______ .__ __. .___________. __ __ _______. ' | \ | | / \ | \/ | | ____| / | / __ \ | ____| | || | | | | ____| | \/ | / __ \ | \ | | | || | | | / | ' | \| | / ^ \ | \ / | | |__ | (----` | | | | | |__ `---| |----`| |__| | | |__ | \ / | | | | | | \| | `---| |----`| |__| | | (----` ' | . ` | / /_\ \ | |\/| | | __| \ \ | | | | | __| | | | __ | | __| | |\/| | | | | | | . ` | | | | __ | \ \ ' | |\ | / _____ \ | | | | | |____ .----) | | `--' | | | | | | | | | | |____ | | | | | `--' | | |\ | | | | | | | .----) | ' |__| \__| /__/ \__\ |__| |__| |_______||_______/ \______/ |__| |__| |__| |__| |_______| |__| |__| \______/ |__| \__| |__| |__| |__| |_______/ ' Public Function MnthName(ByVal dtAnyDate As Date, ByVal strLng As String) 'to call the Function 'To Hijri 'txtMonthNameHijri =MnthName(txtDate,"HJ") 'To Arabic 'txtMonthNameArabic =MnthName(txtDate,"Ar") 'To English 'txtMonthNameEnglish =MnthName(txtDate,"En") 'To English Short 'txtMonthNameEnglish =MnthName(txtDate,"EnShrt") 'To Coptic 'txtMonthNameCoptic =MnthName(txtDate,"Cpti") 'To Syriac 'txtMonthNameSyriac =MnthName(txtDate,"Syr") Dim str01 As String Dim str02 As String Dim str03 As String Dim str04 As String Dim str05 As String Dim str06 As String Dim str07 As String Dim Str08 As String Dim Str09 As String Dim Str10 As String Dim Str11 As String Dim Str12 As String If strLng = "HJ" Then str01 = ChrW("1605") & ChrW("1581") & ChrW("1585") & ChrW("1605") str02 = ChrW("1589") & ChrW("1601") & ChrW("1585") str03 = ChrW("1585") & ChrW("1576") & ChrW("1610") & ChrW("1593") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1571") & ChrW("1608") & ChrW("1604") str04 = ChrW("1585") & ChrW("1576") & ChrW("1610") & ChrW("1593") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1570") & ChrW("1582") & ChrW("1585") str05 = ChrW("1580") & ChrW("1605") & ChrW("1575") & ChrW("1583") & ChrW("1610") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1571") & ChrW("1608") & ChrW("1604") & ChrW("1610") str06 = ChrW("1580") & ChrW("1605") & ChrW("1575") & ChrW("1583") & ChrW("1610") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1570") & ChrW("1582") & ChrW("1585") & ChrW("1577") str07 = ChrW("1585") & ChrW("1580") & ChrW("1576") Str08 = ChrW("1588") & ChrW("1593") & ChrW("1576") & ChrW("1575") & ChrW("1606") Str09 = ChrW("1585") & ChrW("1605") & ChrW("1590") & ChrW("1575") & ChrW("1606") Str10 = ChrW("1588") & ChrW("1608") & ChrW("1575") & ChrW("1604") Str11 = ChrW("1584") & ChrW("1608") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1602") & ChrW("1593") & ChrW("1583") & ChrW("1577") Str12 = ChrW("1584") & ChrW("1608") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1581") & ChrW("1580") & ChrW("1577") ElseIf strLng = "Ar" Then str01 = ChrW("1610") & ChrW("1606") & ChrW("1575") & ChrW("1610") & ChrW("1585") str02 = ChrW("1601") & ChrW("1576") & ChrW("1585") & ChrW("1575") & ChrW("1610") & ChrW("1585") str03 = ChrW("1605") & ChrW("1575") & ChrW("1585") & ChrW("1587") str04 = ChrW("1571") & ChrW("1576") & ChrW("1585") & ChrW("1610") & ChrW("1604") str05 = ChrW("1605") & ChrW("1575") & ChrW("1610") & ChrW("1608") str06 = ChrW("1610") & ChrW("1608") & ChrW("1606") & ChrW("1610") & ChrW("1577") str07 = ChrW("1610") & ChrW("1608") & ChrW("1604") & ChrW("1610") & ChrW("1577") Str08 = ChrW("1571") & ChrW("1594") & ChrW("1587") & ChrW("1591") & ChrW("1587") Str09 = ChrW("1587") & ChrW("1576") & ChrW("1578") & ChrW("1605") & ChrW("1576") & ChrW("1585") Str10 = ChrW("1575") & ChrW("1603") & ChrW("1578") & ChrW("1608") & ChrW("1576") & ChrW("1585") Str11 = ChrW("1606") & ChrW("1608") & ChrW("1601") & ChrW("1605") & ChrW("1576") & ChrW("1585") Str12 = ChrW("1583") & ChrW("1610") & ChrW("1587") & ChrW("1605") & ChrW("1576") & ChrW("1585") ElseIf strLng = "En" Then str01 = "January" str02 = "February" str03 = "March" str04 = "April" str05 = "May" str06 = "June" str07 = "July" Str08 = "August" Str09 = "September" Str10 = "October" Str11 = "November" Str12 = "December" ElseIf strLng = "EnShrt" Then str01 = "Jan" str02 = "Feb" str03 = "Mar" str04 = "Apr" str05 = "May" str06 = "Jun" str07 = "Jul" Str08 = "Aug" Str09 = "Sep" Str10 = "Oct" Str11 = "Nov" Str12 = "Dec" ElseIf strLng = "Cpti" Then str01 = ChrW("1591") & ChrW("1608") & ChrW("1576") & ChrW("1577") str02 = ChrW("1571") & ChrW("1605") & ChrW("1588") & ChrW("1610") & ChrW("1585") str03 = ChrW("1576") & ChrW("1585") & ChrW("1605") & ChrW("1607") & ChrW("1575") & ChrW("1578") str04 = ChrW("1576") & ChrW("1585") & ChrW("1605") & ChrW("1608") & ChrW("1583") & ChrW("1577") str05 = ChrW("1576") & ChrW("1588") & ChrW("1606") & ChrW("1587") str06 = ChrW("1576") & ChrW("1572") & ChrW("1608") & ChrW("1606") & ChrW("1577") str07 = ChrW("1571") & ChrW("1576") & ChrW("1610") & ChrW("1576") Str08 = ChrW("1605") & ChrW("1587") & ChrW("1585") & ChrW("1609") Str09 = ChrW("1578") & ChrW("1608") & ChrW("1578") Str10 = ChrW("1576") & ChrW("1575") & ChrW("1576") & ChrW("1577") Str11 = ChrW("1607") & ChrW("1575") & ChrW("1578") & ChrW("1608") & ChrW("1585") Str12 = ChrW("1603") & ChrW("1610") & ChrW("1575") & ChrW("1607") & ChrW("1603") ElseIf strLng = "Syr" Then str01 = ChrW("1603") & ChrW("1575") & ChrW("1606") & ChrW("1608") & ChrW("1606") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1579") & ChrW("1575") & ChrW("1606") & ChrW("1610") str02 = ChrW("1588") & ChrW("1576") & ChrW("1575") & ChrW("1591") str03 = ChrW("1570") & ChrW("1584") & ChrW("1575") & ChrW("1585") str04 = ChrW("1606") & ChrW("1610") & ChrW("1587") & ChrW("1575") & ChrW("1606") str05 = ChrW("1571") & ChrW("1610") & ChrW("1575") & ChrW("1585") str06 = ChrW("1581") & ChrW("1586") & ChrW("1610") & ChrW("1585") & ChrW("1575") & ChrW("1606") str07 = ChrW("1578") & ChrW("1605") & ChrW("1608") & ChrW("1586") Str08 = ChrW("1570") & ChrW("1576") Str09 = ChrW("1571") & ChrW("1610") & ChrW("1604") & ChrW("1608") & ChrW("1604") Str10 = ChrW("1578") & ChrW("1588") & ChrW("1585") & ChrW("1610") & ChrW("1606") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1571") & ChrW("1608") & ChrW("1604") Str11 = ChrW("1578") & ChrW("1588") & ChrW("1585") & ChrW("1610") & ChrW("1606") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1579") & ChrW("1575") & ChrW("1606") & ChrW("1610") Str12 = ChrW("1603") & ChrW("1575") & ChrW("1606") & ChrW("1608") & ChrW("1606") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1571") & ChrW("1608") & ChrW("1604") End If MnthName = Choose(Format(dtAnyDate, "MM"), str01, str02, str03, str04, str05, str06, str07, Str08, Str09, Str10, Str11, Str12) End Function '----------------------------End------------------------------------------------------------------------------------------- الروتين رقم 5 DayName اسماء الايام - العربى - الانجليزى- اختصار الانجليزى ' .__ __. ___ .___ ___. _______ _______. ______ _______ _______ ___ ____ ____ _______. ' | \ | | / \ | \/ | | ____| / | / __ \ | ____| | \ / \ \ \ / / / | ' | \| | / ^ \ | \ / | | |__ | (----` | | | | | |__ | .--. | / ^ \ \ \/ / | (----` ' | . ` | / /_\ \ | |\/| | | __| \ \ | | | | | __| | | | | / /_\ \ \_ _/ \ \ ' | |\ | / _____ \ | | | | | |____ .----) | | `--' | | | | '--' | / _____ \ | | .----) | ' |__| \__| /__/ \__\ |__| |__| |_______||_______/ \______/ |__| |_______/ /__/ \__\ |__| |_______/ ' Public Function DayName(ByVal dtAnyDate As Date, ByVal strLng As String) 'to call the Function 'To Arabic Day Name 'txtDayNameAR =DayName(txtDate,"Ar") 'To English Day Name 'txtDayNameAR =DayName(txtDate,"En") 'To English Short Day Name 'txtDayNameEnòShrt =DayName(txtDate,"EnShrt") Dim strSat As String Dim strSun As String Dim strMon As String Dim strTues As String Dim strWed As String Dim strThurs As String Dim strFri As String If strLng = "Ar" Then strSat = ChrW("1575") & ChrW("1604") & ChrW("1587") & ChrW("1576") & ChrW("1578") strSun = ChrW("1575") & ChrW("1604") & ChrW("1575") & ChrW("1581") & ChrW("1583") strMon = ChrW("1575") & ChrW("1604") & ChrW("1575") & ChrW("1579") & ChrW("1606") & ChrW("1610") & ChrW("1606") strTues = ChrW("1575") & ChrW("1604") & ChrW("1579") & ChrW("1604") & ChrW("1575") & ChrW("1579") & ChrW("1575") & ChrW("1569") strWed = ChrW("1575") & ChrW("1604") & ChrW("1575") & ChrW("1585") & ChrW("1576") & ChrW("1593") & ChrW("1575") & ChrW("1569") strThurs = ChrW("1575") & ChrW("1604") & ChrW("1582") & ChrW("1605") & ChrW("1610") & ChrW("1587") strFri = ChrW("1575") & ChrW("1604") & ChrW("1580") & ChrW("1605") & ChrW("1593") & ChrW("1577") ElseIf strLng = "En" Then strSat = "Saturday" strSun = "Sunday" strMon = "Monday" strTues = "Tuesday" strWed = "Wednesday" strThurs = "Thursday" strFri = "Friday" ElseIf strLng = "EnShrt" Then strSat = "Sat" strSun = "Sun" strMon = "Mon" strTues = "Tue" strWed = "Wed" strThurs = "Thurs" strFri = "Fri" End If DayName = Choose(Weekday(dtAnyDate), strSun, strMon, strTues, strWed, strThurs, strFri, strSat) End Function '----------------------------End------------------------------------------------------------------------------------------- الروتين رقم 6 عدد ايام الشهر ' .__ __. __ __ .___ ___. .______ _______ .______ ______ _______ _______ ___ ____ ____ _______. ' | \ | | | | | | | \/ | | _ \ | ____|| _ \ / __ \ | ____| | \ / \ \ \ / / / | ' | \| | | | | | | \ / | | |_) | | |__ | |_) | | | | | | |__ | .--. | / ^ \ \ \/ / | (----` ' | . ` | | | | | | |\/| | | _ < | __| | / | | | | | __| | | | | / /_\ \ \_ _/ \ \ ' | |\ | | `--' | | | | | | |_) | | |____ | |\ \----. | `--' | | | | '--' | / _____ \ | | .----) | ' |__| \__| \______/ |__| |__| |______/ |_______|| _| `._____| \______/ |__| |_______/ /__/ \__\ |__| |_______/ ' ______ _______ _______. _______ __ _______ ______ .___________. _______ _______ .___ ___. ______ .__ __. .___________. __ __ ' / __ \ | ____| / || ____|| | | ____| / || || ____|| \ | \/ | / __ \ | \ | | | || | | | ' | | | | | |__ | (----`| |__ | | | |__ | ,----'`---| |----`| |__ | .--. | | \ / | | | | | | \| | `---| |----`| |__| | ' | | | | | __| \ \ | __| | | | __| | | | | | __| | | | | | |\/| | | | | | | . ` | | | | __ | ' | `--' | | | .----) | | |____ | `----.| |____ | `----. | | | |____ | '--' | | | | | | `--' | | |\ | | | | | | | ' \______/ |__| |_______/ |_______||_______||_______| \______| |__| |_______||_______/ |__| |__| \______/ |__| \__| |__| |__| |__| ' Public Function NumofDays(ByVal dtAnyDate As Date) NumofDays = Day(DateSerial(Year(dtAnyDate), Month(dtAnyDate) + 1, 0)) End Function '----------------------------End------------------------------------------------------------------------------------------- الروتين رقم 7 تاريخ آخر يوم فى الشهر ' _______ ___ .___________. _______ ______ _______ __ ___ _______..___________. _______ ___ ____ ____ ' | \ / \ | || ____| / __ \ | ____| | | / \ / || | | \ / \ \ \ / / ' | .--. | / ^ \ `---| |----`| |__ | | | | | |__ | | / ^ \ | (----``---| |----` | .--. | / ^ \ \ \/ / ' | | | | / /_\ \ | | | __| | | | | | __| | | / /_\ \ \ \ | | | | | | / /_\ \ \_ _/ ' | '--' | / _____ \ | | | |____ | `--' | | | | `----. / _____ \ .----) | | | | '--' | / _____ \ | | ' |_______/ /__/ \__\ |__| |_______| \______/ |__| |_______|/__/ \__\ |_______/ |__| |_______/ /__/ \__\ |__| ' ______ _______ _______. _______ __ _______ ______ .___________. _______ _______ .___ ___. ______ .__ __. .___________. __ __ ' / __ \ | ____| / || ____|| | | ____| / || || ____|| \ | \/ | / __ \ | \ | | | || | | | ' | | | | | |__ | (----`| |__ | | | |__ | ,----'`---| |----`| |__ | .--. | | \ / | | | | | | \| | `---| |----`| |__| | ' | | | | | __| \ \ | __| | | | __| | | | | | __| | | | | | |\/| | | | | | | . ` | | | | __ | ' | `--' | | | .----) | | |____ | `----.| |____ | `----. | | | |____ | '--' | | | | | | `--' | | |\ | | | | | | | ' \______/ |__| |_______/ |_______||_______||_______| \______| |__| |_______||_______/ |__| |__| \______/ |__| \__| |__| |__| |__| ' Public Function LastDayInMonth(ByVal dtAnyDate As Date) As Date 'to call the Function 'txtLastDayInMonth =LastDayInMonth(txtDate) LastDayInMonth = DateSerial(Year(dtAnyDate), Month(dtAnyDate) + 1, 0) End Function '----------------------------End------------------------------------------------------------------------------------------- الروتين رقم 8 تاريخ اول يوم فى الشهر Public Function FstDayOfMth(ByVal dtAnyDate As Date) As Date On Error GoTo handleError FstDayOfMth = DateSerial(Year(dtAnyDate), Month(dtAnyDate), 1) GoTo handleSuccess Exit Function handleSuccess: GoTo cleanUp Exit Function handleError: If Err.Number = 94 Then 'createFolder = True Else MsgBox "Error Number : " & Err.Number & vbNewLine & "Error Description : " & Err.Description End If GoTo cleanUp cleanUp: Exit Function End Function الروتين رقم 9 تاريخ اول يوم فى الشهر التالى Public Function FstDayOfNextMnth(ByVal dtAnyDate As Date) As Date FstDayOfNextMnth = DateSerial(Year(dtAnyDate), Month(dtAnyDate) + 1, 1) End Function '----------------------------End------------------------------------------------------------------------------------------- الروتين رقم 10 تاريخ اول يوم فى الشهر السابق Public Function FstDayPrevMnth(ByVal dtAnyDate As Date) As Date FstDayPrevMnth = DateSerial(Year(dtAnyDate), Month(dtAnyDate) - 1, 1) End Function '----------------------------End------------------------------------------------------------------------------------------- الروتين رقم 11 تاريخ آخر يوم فى الشهر Public Function LstDayMnth(ByVal dtAnyDate As Date) As Date LstDayMnth = DateSerial(Year(dtAnyDate), Month(dtAnyDate) + 1, 0) End Function '----------------------------End------------------------------------------------------------------------------------------- الروتين رقم 12 تاريخ آخر يوم فى الشهر التالى Public Function LstDayNextMnth(ByVal dtAnyDate As Date) As Date LstDayNextMnth = DateSerial(Year(dtAnyDate), Month(dtAnyDate) + 2, 0) End Function '----------------------------End------------------------------------------------------------------------------------------- الروتين رقم 13 تاريخ آخر يوم فى الشهر السابق Public Function LstDayPrevMnth(ByVal dtAnyDate As Date) As Date LstDayPrevMnth = DateSerial(Year(dtAnyDate), Month(dtAnyDate), 0) End Function '----------------------------End------------------------------------------------------------------------------------------- الروتين رقم 14 ظهور لغة الوقت التى تريدها - عربى - انجلبزى Public Function TimeByLng(ByVal dtAnyDate As Variant, ByVal strLng As String) Dim strAM As String: strAM = ChrW("1589") & ChrW("1576") & ChrW("1575") & ChrW("1581") & ChrW("1575") & ChrW("1611") Dim strPM As String: strPM = ChrW("1605") & ChrW("1587") & ChrW("1575") & ChrW("1569") & ChrW("1611") If strLng = "Ar" Then TimeByLng = MyNo(Replace(Replace(Format(dtAnyDate, "hh:nn:ss AM/PM"), "AM", strAM), "PM", strPM), "ar") ElseIf strLng = "En" Then TimeByLng = MyNo(Replace(Replace(Format(dtAnyDate, "hh:nn:ss AM/PM"), strAM, "AM"), strPM, "PM"), "En") End If End Function '----------------------------End------------------------------------------------------------------------------------------- الروتين رقم 15 ظهور لغة الوقت التى تريدها - عربى - انجلبزى Public Function TimeLng(ByVal strLng As String) Dim strAM As String: strAM = ChrW("1589") & ChrW("1576") & ChrW("1575") & ChrW("1581") & ChrW("1575") & ChrW("1611") Dim strPM As String: strPM = ChrW("1605") & ChrW("1587") & ChrW("1575") & ChrW("1569") & ChrW("1611") If strLng = "Ar" Then TimeLng = MyNo(Replace(Replace(Format(Now(), "hh:nn:ss AM/PM"), "AM", strAM), "PM", strPM), "ar") ElseIf strLng = "En" Then TimeLng = MyNo(Replace(Replace(Format(Now(), "hh:nn:ss AM/PM"), strAM, "AM"), strPM, "PM"), "En") End If End Function '----------------------------End------------------------------------------------------------------------------------------- الروتين رقم 16 ظهور لغة التاريخ التى تريدها - عربى - انجلبزى Public Function DateByLng(ByVal dtAnyDate As Variant, ByVal strLng As String) If strLng = "Ar" Then DateByLng = MyNo(Format(dtAnyDate, "dd\/mm\/yyyy") & Space(2) & ChrW(1605), "ar") ElseIf strLng = "En" Then DateByLng = MyNo(Format(dtAnyDate, "dd\/mm\/yyyy") & Space(2) & ChrW(1605), "En") End If End Function '----------------------------End------------------------------------------------------------------------------------------- يتبع .... DateFunctions.zip