اذهب الي المحتوي
أوفيسنا

شخابيط وافكار : Date Functions - دوال التاريخ بطعم جديد وتحكم شامل

ابو جودي

بواسطه ابو جودي
في قسم الأكسيس Access

 مشاركة

الردود الموصى بها

ابو جودي

ابو جودي

قام بنشر
قام بنشر (معدل)

السلام عليكم ورحمة الله تعالى وبركاته

تحية طيبة عطرة

موديول واحد قمت بتجميع الدوال الهامة للتاريخ بحيث يسهل استخدامها مع الاخذ فى الاعتبار بمرونة التحكم الشامل فى كل كبيرة وصغيره

بسم الله الرحمن الرحيم وعلى بركة الله

طالما سوف نتطرق الى التاريخ والتعامل معه لابد أن نبدأ على خطى استاذى الجليل و معلمى القدير و والدى الحبيب الاستاذ @jjafferr :fff:

واقتبس من استاذى الجليل تلك الكلمات التى لابد ان تعلق فى اذهان كل من يتعامل مع دوال والتاريخ

في 3‏/11‏/2021 at 11:50, jjafferr said:
  • الاكسس يأخذ تنسيق التاريخ من اعداداتك في الوندوز ، إلا اذا قمت انت بعمل تنسيق آخر للتاريخ في قاعدة بياناتك (لاحظ ان كلامنا كله عن التنسيق ، وليس عن اصل التاريخ) ،
  • انت لما عملت التنسيق هكذا: "mm/dd/yyyy" ، لأنه يتناسب مع التنسيق الذي رأيته في كمبيوترك ، بينما التنسيق في كمبيوتر مستخدم آخر يكون غير (وهذا ما حصل معي) ، فعليه لن يعمل الكود هناك !! وللتغلب على هذه الاشكالية ، استخدم التنسيق للطرفين: 
    "Format([DateOfBirth], 'mm/dd/yyyy') ='" & Format(Me.txtDateOfBirth, "mm/dd/yyyy") & "'"

    لاحظ ان Format غيّرت نوع الحقل من تاريخ الى نص ، فتعاملي لها هنا هو نص ،

  • ابحث في الانترنت عن "date format used natively by JET SQL" حتى تعرف ان المشكلة دولية 🙂

  • داخليا واثناء تنفيذ العمل ، الاكسس يتعامل مع التواريخ بالتنسيق الامريكي: شهر/يوم/سنه ، لهذا السبب ، بعض الاوقات ترى في الاستعلامات ان الاكسس قلب بين اليوم والشهر (1 الى 12) !!
  • الدالة DateFormat تقوم بتحويل التاريخ الى النظام الامريكي ، ومنها يكون التاريخ صحيح ،

الروتين رقم 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-------------------------------------------------------------------------------------------

يتبع ....

 

تم تعديل واضافة بعد الافكار والدوال وهذه هى التعديلات الجديدة
تاريخ الاضافة والتعديل 15/01/2025 

Public Function IsValidDate(ByVal dtDate As Date) As Boolean
    ' الغرض: التحقق مما إذا كان التاريخ المقدم تاريخًا صالحًا.
    ' الوسائط: dtDate - التاريخ المطلوب التحقق منه.
    ' الإرجاع: True إذا كان التاريخ صالحًا؛ وإلا False.
    ' مثال الاستخدام:
    '    If IsValidDate(txtDate) Then
    '        ' قم بعمل شيء ما مع التاريخ الصالح
    '    End If

    On Error Resume Next
    IsValidDate = IsDate(dtDate)
    On Error GoTo 0
End Function

'1
Function FormatDate(ByVal vDate As Variant) As String
    ' الغرض: إرجاع سلسلة نصية بتنسيق التاريخ المستخدم بشكل طبيعي في .
    ' JET SQL.
    ' الوسيط: قيمة تاريخ/وقت.
    ' ملاحظة: يتم إرجاع تنسيق التاريخ فقط إذا لم يكن هناك مكون وقت، أو تنسيق التاريخ/الوقت إذا كان موجودًا.
    '
    ' مثال الاستخدام:
    '    a = DLookup("[some field]", "some table", "[id]=" & Me.ID & " And [Date_Field]=" & FormatDate(The_Date_Field))

    If IsDate(vDate) Then
        If DateValue(vDate) = vDate Then
            FormatDate = Format$(vDate, "\#mm\/dd\/yyyy\#")
        Else
            FormatDate = Format$(vDate, "\#mm\/dd\/yyyy hh\:nn\:ss\#")
        End If
    End If
End Function

Function GetAmericanDateFormat(ByVal vDate As Variant) As Date
    ' الغرض: تنسيق قيمة التاريخ إلى التنسيق الأمريكي (MM-dd-yyyy).
    ' الوسيط: قيمة تاريخ/وقت أو قيمة فارغة/غير محددة.
    ' ملاحظة: يتم إرجاع التاريخ الحالي بتنسيق MM-dd-yyyy إذا كانت الوسيطة فارغة أو غير محددة.
    '
    '
    '
    ' مثال الاستخدام:
    '    formattedDate = GetAmericanDateFormat(SomeDateField)
    
    If IsNull(vDate) Or vDate = vbNullString Or Len(vDate) = 0 Then
        GetAmericanDateFormat = Format(Date, "MM-dd-yyyy", vbUseSystem)
    ElseIf IsValidDate(vDate) Then
        GetAmericanDateFormat = Format(CDate(vDate), "MM-dd-yyyy", vbUseSystem)
    Else
        GetAmericanDateFormat = ""
    End If
End Function

Function GetDateInEuropeanFormat(ByVal vDate As Variant) As Date
    ' الغرض: تنسيق قيمة التاريخ إلى التنسيق الأوروبي (dd-MM-yyyy).
    ' الوسيط: قيمة تاريخ/وقت أو قيمة فارغة/غير محددة.
    ' ملاحظة: يتم إرجاع التاريخ الحالي بتنسيق dd-MM-yyyy إذا كانت الوسيطة فارغة أو غير محددة.
    '
    ' مثال الاستخدام:
    '    formattedDate = GetDateInEuropeanFormat(SomeDateField)

    If IsNull(vDate) Or Len(vDate) = 0 Then
        GetDateInEuropeanFormat = Format(Date, "dd-MM-yyyy", vbUseSystem)
    ElseIf IsValidDate(vDate) Then
        GetDateInEuropeanFormat = Format(CDate(vDate), "dd-MM-yyyy", vbUseSystem)
    Else
        GetDateInEuropeanFormat = ""
    End If
End Function
'----------------------------End-------------------------------------------------------------------------------------------

'2
Public Function ConvertDate(ByRef strInputDate As String, ByVal strConversionType As String) As String
    ' الغرض: تحويل التاريخ بين التنسيق الهجري والميلادي بناءً على نوع التحويل المحدد.
    ' الوسائط: strInputDate - التاريخ المراد تحويله كسلسلة نصية.
    '          strConversionType - نوع التحويل، "H" للتحويل من الهجري إلى الميلادي، "M" للتحويل من الميلادي إلى الهجري.
    ' ملاحظة: يتم تعديل التاريخ وفقًا لليوم التصحيحي من الجدول tblAdjustHjriDate.
    '
    ' مثال الاستخدام:
    '    convertedDate = ConvertDate(txtHijriDate, "H")  ' تحويل من الهجري إلى الميلادي
    '    convertedDate = ConvertDate(txtMiladyDate, "M") ' تحويل من الميلادي إلى الهجري

    Dim intCorrectionDay    As Integer
    Dim intSavedCalendar    As Integer
    Dim dtConvertedDate     As Date
    Dim strFormattedDate    As String

    On Error GoTo ErrorHandler

    ' الحصول على يوم التصحيح من الجدول
    intCorrectionDay = DLookup("[AdjustDay]", "tblAdjustHjriDate")

    ' التحقق من صحة التاريخ المدخل
    If IsValidDate(strInputDate) Then
        ' تعيين نوع التقويم وتحويل التاريخ بناءً على نوع التحويل
        If strConversionType = "M" Then
            ' الميلادي إلى الهجري
            strInputDate = Trim(Format(DateAdd("d", -intCorrectionDay, strInputDate), "dd/mm/yyyy"))
            intSavedCalendar = VBA.calendar
            VBA.calendar = 1
            dtConvertedDate = CDate(strInputDate)
            VBA.calendar = intSavedCalendar
        Else
            ' الهجري إلى الميلادي
            strInputDate = Trim(Format(DateAdd("d", intCorrectionDay, strInputDate), "dd/mm/yyyy"))
            intSavedCalendar = VBA.calendar
            VBA.calendar = 0
            dtConvertedDate = CDate(strInputDate)
            VBA.calendar = 1
        End If

        ' تنسيق التاريخ المحول كسلسلة نصية
        strFormattedDate = Format(dtConvertedDate, "dd/mm/yyyy")
        ConvertDate = strFormattedDate
    Else
        ConvertDate = ""
    End If

    Exit Function

ErrorHandler:
    If err.Number = 13 Then
        MsgBox "تنسيق تاريخ غير صالح. يرجى التحقق من البيانات المدخلة.", vbOKOnly + vbExclamation, "خطأ"
    Else
        MsgBox "حدث خطأ غير متوقع: " & err.Description, vbOKOnly + vbCritical, "خطأ"
    End If
    Exit Function

End Function
'----------------------------End-------------------------------------------------------------------------------------------

'3
Public Function ConvertNumberToLocale(ByVal strNumber As String, ByVal strLocale As String) As String
    ' الغرض: تحويل الأرقام بين النظام العددي العربي والإنجليزي بناءً على اللغة المحددة.
    ' الوسائط: strNumber - السلسلة الرقمية المراد تحويلها.
    '          strLocale - نوع اللغة، "Ar" للأرقام العربية، "En" للأرقام الإنجليزية.
    ' ملاحظة: تقوم بتحويل الأرقام من العربية إلى الإنجليزية والعكس.
    '
    ' مثال الاستخدام:
    '    txtNumberToArabic = ConvertNumberToLocale(txtNumber, "Ar")  ' تحويل الأرقام الإنجليزية إلى عربية
    '    txtNumberToEnglish = ConvertNumberToLocale(txtNumber, "En") ' تحويل الأرقام العربية إلى إنجليزية

    Dim strConvertedNumber As String

    If strLocale = "Ar" Then
        ' تحويل الأرقام الإنجليزية إلى عربية
        strConvertedNumber = Replace(strNumber, ChrW(48), ChrW(1632))                       ' 0
        strConvertedNumber = Replace(strConvertedNumber, ChrW(49), ChrW(1633))              ' 1
        strConvertedNumber = Replace(strConvertedNumber, ChrW(50), ChrW(1634))              ' 2
        strConvertedNumber = Replace(strConvertedNumber, ChrW(51), ChrW(1635))              ' 3
        strConvertedNumber = Replace(strConvertedNumber, ChrW(52), ChrW(1636))              ' 4
        strConvertedNumber = Replace(strConvertedNumber, ChrW(53), ChrW(1637))              ' 5
        strConvertedNumber = Replace(strConvertedNumber, ChrW(54), ChrW(1638))              ' 6
        strConvertedNumber = Replace(strConvertedNumber, ChrW(55), ChrW(1639))              ' 7
        strConvertedNumber = Replace(strConvertedNumber, ChrW(56), ChrW(1640))              ' 8
        strConvertedNumber = Replace(strConvertedNumber, ChrW(57), ChrW(1641))              ' 9
    ElseIf strLocale = "En" Then
        ' تحويل الأرقام العربية إلى إنجليزية
        strConvertedNumber = Replace(strNumber, ChrW(1632), ChrW(48))                       ' 0
        strConvertedNumber = Replace(strConvertedNumber, ChrW(1633), ChrW(49))              ' 1
        strConvertedNumber = Replace(strConvertedNumber, ChrW(1634), ChrW(50))              ' 2
        strConvertedNumber = Replace(strConvertedNumber, ChrW(1635), ChrW(51))              ' 3
        strConvertedNumber = Replace(strConvertedNumber, ChrW(1636), ChrW(52))              ' 4
        strConvertedNumber = Replace(strConvertedNumber, ChrW(1637), ChrW(53))              ' 5
        strConvertedNumber = Replace(strConvertedNumber, ChrW(1638), ChrW(54))              ' 6
        strConvertedNumber = Replace(strConvertedNumber, ChrW(1639), ChrW(55))              ' 7
        strConvertedNumber = Replace(strConvertedNumber, ChrW(1640), ChrW(56))              ' 8
        strConvertedNumber = Replace(strConvertedNumber, ChrW(1641), ChrW(57))              ' 9
    End If

    ConvertNumberToLocale = strConvertedNumber

End Function
'----------------------------End-------------------------------------------------------------------------------------------

'4
Public Function GetMonthName(ByVal dtDate As Date, ByVal strLocale As String) As String
    ' الغرض: إرجاع اسم الشهر بناءً على اللغة المحددة.
    ' الوسائط: dtDate - التاريخ الذي يتم استخراج اسم الشهر منه.
    '          strLocale - نوع اللغة لتحديد لغة اسم الشهر.
    '                      "HJ" للهجري، "Ar" للعربية، "En" للإنجليزية، "EnShrt" للإنجليزية المختصرة،
    '                      "Cpti" للقبطية، "Syr" للسريانية.
    ' الإرجاع: اسم الشهر باللغة المحددة.
    '
    ' مثال الاستخدام:
    '    txtMonthNameHijri = GetMonthName(txtDate, "HJ")       ' اسم الشهر الهجري
    '    txtMonthNameArabic = GetMonthName(txtDate, "Ar")     ' اسم الشهر العربي
    '    txtMonthNameEnglish = GetMonthName(txtDate, "En")    ' اسم الشهر الإنجليزي
    '    txtMonthNameEnglishShort = GetMonthName(txtDate, "EnShrt") ' اسم الشهر الإنجليزي المختصر
    '    txtMonthNameCoptic = GetMonthName(txtDate, "Cpti")    ' اسم الشهر القبطي
    '    txtMonthNameSyriac = GetMonthName(txtDate, "Syr")     ' اسم الشهر السرياني
    
    Dim strMonthName(12) As String
    
    ' التحقق من صحة اللغة المحددة
    If strLocale <> "HJ" And strLocale <> "Ar" And strLocale <> "En" And strLocale <> "EnShrt" And strLocale <> "Cpti" And strLocale <> "Syr" And strLocale <> "No" Then
        MsgBox "اللغة المحددة غير صالحة. يرجى استخدام 'HJ'، 'Ar'، 'En'، 'EnShrt'، 'Cpti'، 'Syr'، أو 'No'.", vbExclamation, "خطأ"
        Exit Function
    End If
    
    If IsValidDate(dtDate) Then
        ' تحديد أسماء الأشهر لكل لغة
        Select Case strLocale
        Case "HJ"
            ' أسماء الأشهر الهجرية
            strMonthName(1) = "محرم"
            strMonthName(2) = "صفر"
            strMonthName(3) = "ربيع الأول"
            strMonthName(4) = "ربيع الآخر"
            strMonthName(5) = "جمادى الأولى"
            strMonthName(6) = "جمادى الآخرة"
            strMonthName(7) = "رجب"
            strMonthName(8) = "شعبان"
            strMonthName(9) = "رمضان"
            strMonthName(10) = "شوال"
            strMonthName(11) = "ذو القعدة"
            strMonthName(12) = "ذو الحجة"
            
        Case "Ar"
            ' أسماء الأشهر العربية
            strMonthName(1) = "يناير"
            strMonthName(2) = "فبراير"
            strMonthName(3) = "مارس"
            strMonthName(4) = "أبريل"
            strMonthName(5) = "مايو"
            strMonthName(6) = "يونيو"
            strMonthName(7) = "يوليو"
            strMonthName(8) = "أغسطس"
            strMonthName(9) = "سبتمبر"
            strMonthName(10) = "أكتوبر"
            strMonthName(11) = "نوفمبر"
            strMonthName(12) = "ديسمبر"
            
        Case "En"
            ' أسماء الأشهر الإنجليزية
            strMonthName(1) = "January"
            strMonthName(2) = "February"
            strMonthName(3) = "March"
            strMonthName(4) = "April"
            strMonthName(5) = "May"
            strMonthName(6) = "June"
            strMonthName(7) = "July"
            strMonthName(8) = "August"
            strMonthName(9) = "September"
            strMonthName(10) = "October"
            strMonthName(11) = "November"
            strMonthName(12) = "December"
            
        Case "EnShrt"
            ' أسماء الأشهر الإنجليزية المختصرة
            strMonthName(1) = "Jan"
            strMonthName(2) = "Feb"
            strMonthName(3) = "Mar"
            strMonthName(4) = "Apr"
            strMonthName(5) = "May"
            strMonthName(6) = "Jun"
            strMonthName(7) = "Jul"
            strMonthName(8) = "Aug"
            strMonthName(9) = "Sep"
            strMonthName(10) = "Oct"
            strMonthName(11) = "Nov"
            strMonthName(12) = "Dec"
            
        Case "Cpti"
            ' أسماء الأشهر القبطية
            strMonthName(1) = "Thout"
            strMonthName(2) = "Paope"
            strMonthName(3) = "Hator"
            strMonthName(4) = "Kiahk"
            strMonthName(5) = "Tobi"
            strMonthName(6) = "Meshir"
            strMonthName(7) = "Paremhat"
            strMonthName(8) = "Paremhou"
            strMonthName(9) = "Pashons"
            strMonthName(10) = "Paoni"
            strMonthName(11) = "Epip"
            strMonthName(12) = "Nasi"
            
        Case "Syr"
            ' أسماء الأشهر السريانية
            strMonthName(1) = "Nisan"
            strMonthName(2) = "Iyar"
            strMonthName(3) = "Sivan"
            strMonthName(4) = "Tammuz"
            strMonthName(5) = "Ab"
            strMonthName(6) = "Elul"
            strMonthName(7) = "Tishri"
            strMonthName(8) = "Heshvan"
            strMonthName(9) = "Kislev"
            strMonthName(10) = "Tevet"
            strMonthName(11) = "Shevat"
            strMonthName(12) = "Adar"
            
        Case "No"
            ' أسماء الأشهر بالأرقام
            strMonthName(1) = "( 01 )"
            strMonthName(2) = "( 02 )"
            strMonthName(3) = "( 03 )"
            strMonthName(4) = "( 04 )"
            strMonthName(5) = "( 05 )"
            strMonthName(6) = "( 06 )"
            strMonthName(7) = "( 07 )"
            strMonthName(8) = "( 08 )"
            strMonthName(9) = "( 09 )"
            strMonthName(10) = "( 10 )"
            strMonthName(11) = "( 11 )"
            strMonthName(12) = "( 12 )"
        End Select
        
        ' إرجاع اسم الشهر للتاريخ المحدد
        GetMonthName = strMonthName(Month(dtDate))
    Else
        ' إرجاع سلسلة فارغة إذا كان التاريخ غير صالح
        GetMonthName = ""
    End If
End Function '----------------------------End-------------------------------------------------------------------------------------------

'5
Public Function GetDayName(ByVal dtAnyDate As Date, ByVal strLng As String) As String
    ' الغرض: إرجاع اسم اليوم بناءً على التاريخ واللغة المحددة.
    ' الوسائط: dtAnyDate - التاريخ الذي يتم استخراج اسم اليوم منه.
    '          strLng - نوع اللغة لاسم اليوم:
    '                   "Ar" للعربية، "En" للإنجليزية، "EnShrt" للإنجليزية المختصرة.
    ' الإرجاع: اسم اليوم باللغة المحددة.
    '
    ' مثال الاستخدام:
    '    txtDayNameAR = DayName(txtDate, "Ar")        ' اسم اليوم بالعربية
    '    txtDayNameEn = DayName(txtDate, "En")        ' اسم اليوم بالإنجليزية
    '    txtDayNameEnShrt = 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

    ' التحقق من أن dtAnyDate تاريخ صالح
    If Not IsDate(dtAnyDate) Then
        MsgBox "الإدخال ليس تاريخًا صالحًا. يرجى إدخال تاريخ صحيح.", vbExclamation, "تاريخ غير صالح"
        GetDayName = "تاريخ غير صالح"
        Exit Function
    End If
    
    ' التحقق من صحة اللغة المحددة
    If strLng <> "Ar" And strLng <> "En" And strLng <> "EnShrt" Then
        MsgBox "اللغة المحددة غير صالحة. يرجى استخدام 'Ar'، 'En'، أو 'EnShrt'.", vbExclamation, "خطأ"
        Exit Function
    End If
    
    ' تحديد أسماء الأيام بناءً على اللغة
    Select Case strLng
        Case "Ar"
            strSat = "السبت"
            strSun = "الأحد"
            strMon = "الاثنين"
            strTues = "الثلاثاء"
            strWed = "الأربعاء"
            strThurs = "الخميس"
            strFri = "الجمعة"

        Case "En"
            strSat = "Saturday"
            strSun = "Sunday"
            strMon = "Monday"
            strTues = "Tuesday"
            strWed = "Wednesday"
            strThurs = "Thursday"
            strFri = "Friday"
            
        Case "EnShrt"
            strSat = "Sat"
            strSun = "Sun"
            strMon = "Mon"
            strTues = "Tue"
            strWed = "Wed"
            strThurs = "Thu"
            strFri = "Fri"
    End Select

    ' إرجاع اسم اليوم بناءً على يوم الأسبوع للتاريخ المحدد
    GetDayName = Choose(Weekday(dtAnyDate), strSun, strMon, strTues, strWed, strThurs, strFri, strSat)
End Function
'----------------------------End-------------------------------------------------------------------------------------------


'6
Public Function NumofDays(ByVal dtAnyDate As Date) As Integer
    ' الغرض: إرجاع عدد الأيام في شهر التاريخ المحدد.
    ' الوسائط: dtAnyDate - التاريخ الذي يتم استخراج عدد الأيام في شهره.
    ' الإرجاع: عدد الأيام في شهر التاريخ المحدد.
    '
    ' مثال الاستخدام:
    '    txtNumofDaysMonth = NumofDays(txtDate)
    ' حساب آخر يوم في الشهر الحالي باستخدام الدالة DateSerial
    ' ثم إرجاع جزء اليوم من ذلك التاريخ، والذي يمثل العدد الإجمالي للأيام في ذلك الشهر.
    
    ' التحقق من أن dtAnyDate تاريخ صالح
    If Not IsDate(dtAnyDate) Then
        MsgBox "الإدخال ليس تاريخًا صالحًا. يرجى إدخال تاريخ صحيح.", vbExclamation, "تاريخ غير صالح"
        NumofDays = -1 ' إرجاع قيمة غير صالحة للإشارة إلى خطأ
        Exit Function
    End If
    
    NumofDays = Day(DateSerial(Year(dtAnyDate), Month(dtAnyDate) + 1, 0))
End Function
'----------------------------End-------------------------------------------------------------------------------------------


'7
Public Function GetLastDayInMonth(ByVal dtAnyDate As Date) As Date
    ' الغرض: إرجاع آخر يوم في شهر التاريخ المحدد.
    ' الوسائط: dtAnyDate - التاريخ الذي يتم استخراج آخر يوم في شهره.
    ' الإرجاع: آخر يوم في شهر التاريخ المحدد.
    '
    ' مثال الاستخدام:
    '    txtLastDayInMonth = GetLastDayInMonth(txtDate)

    ' حساب آخر يوم في الشهر الحالي باستخدام الدالة DateSerial.
    ' تقوم هذه الدالة بإنشاء تاريخ مع السنة والشهر من التاريخ المحدد وتعيين اليوم إلى 0،
    ' مما يعطينا بشكل فعال آخر يوم في الشهر السابق، أي آخر يوم في الشهر الحالي.
    
    ' التحقق من أن dtAnyDate تاريخ صالح
    If Not IsDate(dtAnyDate) Then
        MsgBox "الإدخال ليس تاريخًا صالحًا. يرجى إدخال تاريخ صحيح.", vbExclamation, "تاريخ غير صالح"
        GetLastDayInMonth = CDate("0001-01-01") ' إرجاع تاريخ غير صالح للإشارة إلى خطأ
        Exit Function
    End If
    
    GetLastDayInMonth = DateSerial(Year(dtAnyDate), Month(dtAnyDate) + 1, 0)
End Function
'----------------------------End-------------------------------------------------------------------------------------------

'8
Public Function GetFirstDayOfMonth(ByVal dtAnyDate As Date) As Date
    ' الغرض: إرجاع أول يوم في شهر التاريخ المحدد.
    ' الوسائط: dtAnyDate - التاريخ الذي يتم استخراج أول يوم في شهره.
    ' الإرجاع: أول يوم في شهر التاريخ المحدد.
    '
    ' مثال الاستخدام:
    '    txtFirstDayOfMonth = GetFirstDayOfMonth(txtDate)

    ' التحقق من أن dtAnyDate تاريخ صالح
    If Not IsDate(dtAnyDate) Then
        MsgBox "الإدخال ليس تاريخًا صالحًا. يرجى إدخال تاريخ صحيح.", vbExclamation, "تاريخ غير صالح"
        GetFirstDayOfMonth = CDate("0001-01-01") ' إرجاع تاريخ غير صالح للإشارة إلى خطأ
        Exit Function
    End If
    
    ' حساب أول يوم في الشهر الحالي باستخدام الدالة DateSerial
    GetFirstDayOfMonth = DateSerial(Year(dtAnyDate), Month(dtAnyDate), 1)
End Function
'----------------------------End-------------------------------------------------------------------------------------------

'9
Public Function GetFirstDayOfNextMonth(ByVal dtAnyDate As Date) As Date
    ' الغرض: إرجاع أول يوم في الشهر التالي للتاريخ المحدد.
    ' الوسائط: dtAnyDate - التاريخ الذي يتم استخراج أول يوم في الشهر التالي له.
    ' الإرجاع: أول يوم في الشهر التالي للتاريخ المحدد.
    '
    ' مثال الاستخدام:
    '    txtFirstDayOfNextMonth = GetFirstDayOfNextMonth(txtDate)

    ' التحقق من أن dtAnyDate تاريخ صالح
    If Not IsDate(dtAnyDate) Then
        MsgBox "الإدخال ليس تاريخًا صالحًا. يرجى إدخال تاريخ صحيح.", vbExclamation, "تاريخ غير صالح"
        GetFirstDayOfNextMonth = CDate("0001-01-01") ' إرجاع تاريخ غير صالح للإشارة إلى خطأ
        Exit Function
    End If
    
    ' إرجاع أول يوم في الشهر التالي باستخدام الدالة DateSerial
    GetFirstDayOfNextMonth = DateSerial(Year(dtAnyDate), Month(dtAnyDate) + 1, 1)
End Function
'----------------------------End-------------------------------------------------------------------------------------------

'10
Public Function GetFirstDayOfPreviousMonth(ByVal dtAnyDate As Date) As Date
    ' الغرض: إرجاع أول يوم في الشهر السابق للتاريخ المحدد.
    ' الوسائط: dtAnyDate - التاريخ الذي يتم استخراج أول يوم في الشهر السابق له.
    ' الإرجاع: أول يوم في الشهر السابق للتاريخ المحدد.
    '
    ' مثال الاستخدام:
    '    txtFirstDayOfPreviousMonth = GetFirstDayOfPreviousMonth(txtDate)

    ' التحقق من أن dtAnyDate تاريخ صالح
    If Not IsDate(dtAnyDate) Then
        MsgBox "الإدخال ليس تاريخًا صالحًا. يرجى إدخال تاريخ صحيح.", vbExclamation, "تاريخ غير صالح"
        GetFirstDayOfPreviousMonth = CDate("0001-01-01") ' إرجاع تاريخ غير صالح للإشارة إلى خطأ
        Exit Function
    End If
    
    ' إرجاع أول يوم في الشهر السابق باستخدام الدالة DateSerial
    GetFirstDayOfPreviousMonth = DateSerial(Year(dtAnyDate), Month(dtAnyDate) - 1, 1)
End Function
'----------------------------End-------------------------------------------------------------------------------------------

'11
Public Function GetLastDayOfMonth(ByVal dtAnyDate As Date) As Date
    ' الغرض: إرجاع آخر يوم في شهر التاريخ المحدد.
    ' الوسائط: dtAnyDate - التاريخ الذي يتم استخراج آخر يوم في شهره.
    ' الإرجاع: آخر يوم في شهر التاريخ المحدد.
    '
    ' مثال الاستخدام:
    '    txtLastDayOfMonth = GetLastDayOfMonth(txtDate)

    ' التحقق من أن dtAnyDate تاريخ صالح
    If Not IsDate(dtAnyDate) Then
        MsgBox "الإدخال ليس تاريخًا صالحًا. يرجى إدخال تاريخ صحيح.", vbExclamation, "تاريخ غير صالح"
        GetLastDayOfMonth = CDate("0001-01-01") ' إرجاع تاريخ غير صالح للإشارة إلى خطأ
        Exit Function
    End If
    
    ' إرجاع آخر يوم في الشهر باستخدام الدالة DateSerial
    GetLastDayOfMonth = DateSerial(Year(dtAnyDate), Month(dtAnyDate) + 1, 0)
End Function
'----------------------------End-------------------------------------------------------------------------------------------

'12
Public Function GetLastDayOfNextMonth(ByVal dtAnyDate As Date) As Date
    ' الغرض: إرجاع آخر يوم في الشهر التالي للتاريخ المحدد.
    ' الوسائط: dtAnyDate - التاريخ الذي يتم استخراج آخر يوم في الشهر التالي له.
    ' الإرجاع: آخر يوم في الشهر التالي للتاريخ المحدد.
    '
    ' مثال الاستخدام:
    '    txtLastDayOfNextMonth = GetLastDayOfNextMonth(txtDate)

    ' التحقق من أن dtAnyDate تاريخ صالح
    If Not IsDate(dtAnyDate) Then
        MsgBox "الإدخال ليس تاريخًا صالحًا. يرجى إدخال تاريخ صحيح.", vbExclamation, "تاريخ غير صالح"
        GetLastDayOfNextMonth = CDate("0001-01-01") ' إرجاع تاريخ غير صالح للإشارة إلى خطأ
        Exit Function
    End If
    
    ' إرجاع آخر يوم في الشهر التالي باستخدام الدالة DateSerial
    GetLastDayOfNextMonth = DateSerial(Year(dtAnyDate), Month(dtAnyDate) + 2, 0)
End Function
'----------------------------End-------------------------------------------------------------------------------------------

'13
Public Function GetLastDayOfPreviousMonth(ByVal dtAnyDate As Date) As Date
    ' الغرض: إرجاع آخر يوم في الشهر السابق للتاريخ المحدد.
    ' الوسائط: dtAnyDate - التاريخ الذي يتم استخراج آخر يوم في الشهر السابق له.
    ' الإرجاع: آخر يوم في الشهر السابق للتاريخ المحدد.
    '
    ' مثال الاستخدام:
    '    txtLastDayOfPreviousMonth = GetLastDayOfPreviousMonth(txtDate)

    ' التحقق من أن dtAnyDate تاريخ صالح
    If Not IsDate(dtAnyDate) Then
        MsgBox "الإدخال ليس تاريخًا صالحًا. يرجى إدخال تاريخ صحيح.", vbExclamation, "تاريخ غير صالح"
        GetLastDayOfPreviousMonth = CDate("0001-01-01") ' إرجاع تاريخ غير صالح للإشارة إلى خطأ
        Exit Function
    End If
    
    ' إرجاع آخر يوم في الشهر السابق باستخدام الدالة DateSerial
    GetLastDayOfPreviousMonth = DateSerial(Year(dtAnyDate), Month(dtAnyDate), 0)
End Function '----------------------------End-------------------------------------------------------------------------------------------

'14
Public Function TimeByLanguage(ByVal dtAnyDate As Variant, ByVal strLng As String) As String
    ' الغرض: إرجاع الوقت بتنسيق اللغة المحددة.
    ' الوسائط: dtAnyDate - التاريخ/الوقت الذي يتم تنسيقه.
    '          strLng - اللغة المحددة لتنسيق الوقت ("Ar" للعربية، "En" للإنجليزية).
    ' الإرجاع: الوقت بتنسيق اللغة المحددة.
    '
    ' مثال الاستخدام:
    '    txtTimeArabic = TimeByLanguage(txtDateTime, "Ar") ' الوقت بالعربية
    '    txtTimeEnglish = TimeByLanguage(txtDateTime, "En") ' الوقت بالإنجليزية

    ' التحقق من أن dtAnyDate تاريخ/وقت صالح
    If Not IsDate(dtAnyDate) Then
        MsgBox "الإدخال ليس تاريخًا/وقتًا صالحًا. يرجى إدخال تاريخ/وقت صحيح.", vbExclamation, "تاريخ/وقت غير صالح"
        TimeByLanguage = "تاريخ/وقت غير صالح"
        Exit Function
    End If

    ' تعريف نصوص AM وPM للغة العربية
    Dim strAm As String: strAm = "صباحًا "
    Dim strPm As String: strPm = "مساءً "
    
    ' تنسيق الوقت بناءً على اللغة المحددة
    Select Case strLng
        Case "Ar"
            ' تحويل الوقت إلى العربية واستبدال AM/PM بالنصوص العربية
            TimeByLanguage = ConvertNumberToLocale(Replace(Replace(Format(dtAnyDate, "hh:nn:ss AM/PM"), "AM", strAm), "PM", strPm), "Ar")
        Case "En"
            ' تحويل الوقت إلى الإنجليزية واستبدال النصوص العربية بـ AM/PM
            TimeByLanguage = ConvertNumberToLocale(Replace(Replace(Format(dtAnyDate, "hh:nn:ss AM/PM"), strAm, "AM"), strPm, "PM"), "En")
        Case Else
            ' إرجاع رسالة خطأ إذا كانت اللغة غير مدعومة
            TimeByLanguage = "اللغة غير مدعومة"
    End Select
End Function
'----------------------------End-------------------------------------------------------------------------------------------

'15
Public Function GetLocalizedTimeString(ByVal strLng As String) As String
    ' الغرض: إرجاع الوقت الحالي بتنسيق اللغة المحددة.
    ' الوسائط: strLng - اللغة المحددة لتنسيق الوقت ("Ar" للعربية، "En" للإنجليزية).
    ' الإرجاع: الوقت الحالي بتنسيق اللغة المحددة.
    '
    ' مثال الاستخدام:
    '    txtTimeArabic = GetLocalizedTimeString("Ar") ' الوقت الحالي بالعربية
    '    txtTimeEnglish = GetLocalizedTimeString("En") ' الوقت الحالي بالإنجليزية

    ' تعريف نصوص AM وPM للغة العربية
    Dim strAm As String: strAm = "صباحًا "
    Dim strPm As String: strPm = "مساءً "

    ' تنسيق الوقت بناءً على اللغة المحددة
    Select Case strLng
        Case "Ar"
            ' تحويل الوقت الحالي إلى العربية واستبدال AM/PM بالنصوص العربية
            GetLocalizedTimeString = ConvertNumberToLocale(Replace(Replace(Format(Now(), "hh:nn:ss AM/PM"), "AM", strAm), "PM", strPm), "Ar")
        Case "En"
            ' تحويل الوقت الحالي إلى الإنجليزية واستبدال النصوص العربية بـ AM/PM
            GetLocalizedTimeString = ConvertNumberToLocale(Replace(Replace(Format(Now(), "hh:nn:ss AM/PM"), strAm, "AM"), strPm, "PM"), "En")
        Case Else
            ' إرجاع رسالة خطأ إذا كانت اللغة غير مدعومة
            GetLocalizedTimeString = "اللغة غير مدعومة"
    End Select
End Function
'----------------------------End-------------------------------------------------------------------------------------------

'16
Public Function FormatDateByLanguage(ByVal dtAnyDate As Variant, ByVal strLng As String) As String
    ' الغرض: إرجاع التاريخ بتنسيق اللغة المحددة.
    ' الوسائط: dtAnyDate - التاريخ الذي يتم تنسيقه.
    '          strLng - اللغة المحددة لتنسيق التاريخ ("Ar" للعربية، "En" للإنجليزية).
    ' الإرجاع: التاريخ بتنسيق اللغة المحددة.
    '
    ' مثال الاستخدام:
    '    txtDateArabic = FormatDateByLanguage(txtDate, "Ar") ' التاريخ بالعربية
    '    txtDateEnglish = FormatDateByLanguage(txtDate, "En") ' التاريخ بالإنجليزية

    ' التحقق من أن dtAnyDate تاريخ صالح
    If Not IsDate(dtAnyDate) Then
        MsgBox "الإدخال ليس تاريخًا صالحًا. يرجى إدخال تاريخ صحيح.", vbExclamation, "تاريخ غير صالح"
        FormatDateByLanguage = "تاريخ غير صالح"
        Exit Function
    End If
    
    ' تنسيق التاريخ بناءً على اللغة المحددة
    Select Case strLng
        Case "Ar"
            ' تحويل التاريخ إلى العربية وإضافة رمز "م" (لتحديد التقويم الميلادي)
            FormatDateByLanguage = ConvertNumberToLocale(Format(dtAnyDate, "dd\/mm\/yyyy") & Space(2) & "م ", "Ar")
        Case "En"
            ' تحويل التاريخ إلى الإنجليزية وإضافة رمز "هـ" (لتحديد التقويم الهجري)
            FormatDateByLanguage = ConvertNumberToLocale(Format(dtAnyDate, "dd\/mm\/yyyy") & Space(2) & "هـ ", "En")
        Case Else
            ' إرجاع رسالة خطأ إذا كانت اللغة غير مدعومة
            FormatDateByLanguage = "اللغة غير مدعومة"
    End Select
End Function
'----------------------------End-------------------------------------------------------------------------------------------


Public Function GetFirstDayOfYear(Optional ReferenceYear As Integer = 0) As Date
    ' الغرض: إرجاع أول يوم في السنة المحددة.
    ' الوسائط: ReferenceYear - السنة المرجعية (اختياري، إذا لم يتم تحديدها، يتم استخدام السنة الحالية).
    ' الإرجاع: أول يوم في السنة المحددة (1 يناير).
    '
    ' مثال الاستخدام:
    '    txtFirstDayOfYear = GetFirstDayOfYear(2023) ' أول يوم في سنة 2023
    '    txtFirstDayOfYear = GetFirstDayOfYear()     ' أول يوم في السنة الحالية

    ' تحديد السنة المرجعية
    If ReferenceYear = 0 Then
        ReferenceYear = Year(Now) ' استخدام السنة الحالية إذا لم يتم تحديد سنة مرجعية
    End If
    
    ' إرجاع أول يوم في السنة (1 يناير)
    GetFirstDayOfYear = DateSerial(ReferenceYear, 1, 1)
End Function
'----------------------------End-------------------------------------------------------------------------------------------


Public Function GetLastDayOfYear(Optional ReferenceYear As Integer = 0) As Date
    ' الغرض: إرجاع آخر يوم في السنة المحددة.
    ' الوسائط: ReferenceYear - السنة المرجعية (اختياري، إذا لم يتم تحديدها، يتم استخدام السنة الحالية).
    ' الإرجاع: آخر يوم في السنة المحددة (31 ديسمبر).
    '
    ' مثال الاستخدام:
    '    txtLastDayOfYear = GetLastDayOfYear(2023) ' آخر يوم في سنة 2023
    '    txtLastDayOfYear = GetLastDayOfYear()     ' آخر يوم في السنة الحالية

    ' تحديد السنة المرجعية
    If ReferenceYear = 0 Then
        ReferenceYear = Year(Now) ' استخدام السنة الحالية إذا لم يتم تحديد سنة مرجعية
    End If
    
    ' إرجاع آخر يوم في السنة (31 ديسمبر)
    GetLastDayOfYear = DateSerial(ReferenceYear, 12, 31)
End Function
'----------------------------End-------------------------------------------------------------------------------------------

'  حساب الفرق بين تاريخين (بالأيام، الأشهر، السنوات)
Public Function GetDateDifferenceInDays(ByVal dtStartDate As Date, ByVal dtEndDate As Date) As Long
    ' الغرض: حساب الفرق بين تاريخين بالأيام.
    GetDateDifferenceInDays = DateDiff("d", dtStartDate, dtEndDate)
End Function

Public Function GetDateDifferenceInMonths(ByVal dtStartDate As Date, ByVal dtEndDate As Date) As Long
    ' الغرض: حساب الفرق بين تاريخين بالأشهر.
    GetDateDifferenceInMonths = DateDiff("m", dtStartDate, dtEndDate)
End Function

Public Function GetDateDifferenceInYears(ByVal dtStartDate As Date, ByVal dtEndDate As Date) As Long
    ' الغرض: حساب الفرق بين تاريخين بالسنوات.
    GetDateDifferenceInYears = DateDiff("yyyy", dtStartDate, dtEndDate)
End Function
'----------------------------End-------------------------------------------------------------------------------------------

' إضافة أو طرح أيام/أشهر/سنوات من تاريخ معين
Public Function AddDaysToDate(ByVal dtDate As Date, ByVal intDays As Integer) As Date
    ' الغرض: إضافة أو طرح عدد محدد من الأيام من تاريخ معين.
    AddDaysToDate = DateAdd("d", intDays, dtDate)
End Function

Public Function AddMonthsToDate(ByVal dtDate As Date, ByVal intMonths As Integer) As Date
    ' الغرض: إضافة أو طرح عدد محدد من الأشهر من تاريخ معين.
    AddMonthsToDate = DateAdd("m", intMonths, dtDate)
End Function

Public Function AddYearsToDate(ByVal dtDate As Date, ByVal intYears As Integer) As Date
    ' الغرض: إضافة أو طرح عدد محدد من السنوات من تاريخ معين.
    AddYearsToDate = DateAdd("yyyy", intYears, dtDate)
End Function
'----------------------------End-------------------------------------------------------------------------------------------

' التحقق مما إذا كان تاريخ معين ضمن نطاق تاريخين
Public Function IsDateInRange(ByVal dtDate As Date, ByVal dtStartDate As Date, ByVal dtEndDate As Date) As Boolean
    ' الغرض: التحقق مما إذا كان تاريخ معين يقع بين تاريخين محددين.
    IsDateInRange = (dtDate >= dtStartDate And dtDate <= dtEndDate)
End Function
'----------------------------End-------------------------------------------------------------------------------------------

' حساب العمر بناءً على تاريخ الميلاد
Public Function CalculateAge(ByVal dtBirthDate As Date) As Integer
    ' الغرض: حساب العمر بالسنوات بناءً على تاريخ الميلاد.
    CalculateAge = DateDiff("yyyy", dtBirthDate, Now)
    If DateSerial(Year(Now), Month(dtBirthDate), Day(dtBirthDate)) > Now Then
        CalculateAge = CalculateAge - 1
    End If
End Function
'----------------------------End-------------------------------------------------------------------------------------------

' تحديد عدد الأيام منذ تاريخ معين
Public Function GetDaysSinceDate(ByVal dtStartDate As Date) As Integer
    ' الغرض: حساب عدد الأيام المنقضية منذ تاريخ معين.
    GetDaysSinceDate = DateDiff("d", dtStartDate, Now)
End Function
'----------------------------End-------------------------------------------------------------------------------------------


اتمنى لكم الاستفادة والتجربة الممتعة

DateFunctions.zip

تم تعديل بواسطه ابو جودي
اضافة دوال وافكار جديدة
  • Like 6
  • Thanks 2
Moosak

Moosak

قام بنشر
قام بنشر

شكله برنامج مكتبة الأكواد جاي في وقته 😅✋🏻

متشكرين يا مولانا 🙂

  • Thanks 1
ابو جودي

ابو جودي

قام بنشر
  • الكاتب
قام بنشر
في 17‏/3‏/2022 at 15:55, SEMO.Pa3x said:

بارك الله بك اخي ابا جودي، فعلا موضوع مفيد ( تم الحفظ في المفضلة ).

جزاكم الله خيرا يا دكتور @SEMO.Pa3x :fff:

لى عظيم الشرف ان يتم الاحتفاظ بأفكارى المتواضعة فى مفضلة احد اساتذة وأعمدة المنتدى الذين أتعلم منهم وعلى أيديهم

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 مشاركة
الذهاب الي قائمه المواضيع
×
×
  • اضف...

Important Information

  I accept