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

**ابو جودي** · مارس 17, 2022

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

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

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

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

طالما سوف نتطرق الى التاريخ والتعامل معه لابد أن نبدأ على خطى استاذى الجليل و معلمى القدير و والدى الحبيب الاستاذ @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-------------------------------------------------------------------------------------------

يتبع ....

DateFunctions.zip

**SEMO.Pa3x** · مارس 17, 2022

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

**abouelhassan** · مارس 17, 2022

زادك الله من فضله اخى

اكثر الله خيرك

احترامى

**Moosak** · مارس 17, 2022

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

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

**ابو جودي** · مارس 20, 2022

في 17‏/3‏/2022 at 15:55, SEMO.Pa3x said:

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

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

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

تسجيل الدخول

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

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

ابو جودي

SEMO.Pa3x

abouelhassan

Moosak

ابو جودي

Join the conversation

محتوي مشابه

system try شخابيط: التحكم الكامل فى واجهة اكسس ( تصغير بجوار الساعة - توسيط - اخفاء - تغيير أيقونة شعار أكسس )

immediatewindow شخابيط وافكار : اليوم اقدم اليكم منفعة لا غنى عنها (ImmediateWindowHelper)

commandbars configuration اشرطة الاوامر المخصصة CommandBars

sql to vba converter tool فكرة قيد التطوير اداة متعددة المنافع للتعامل مع جمل SQL للتحويل الى VBA والعكس

لعبة ترتيب الأرقام - تنمية مهارة التركيز 😊💪🏻

تصفح هذا الموضوع مؤخراً 0 اعضاء متواجدين الان

تصفح الموقع

تصفح جديد الموقع

Support

Important Information