أيام الشهور ميلادي ، هجري ، أم القرى

السلام عليكم

دالتان لمعرفة أيام الشهور كالتالي :

الدالة الأولى تحتاج إلى تمرير رقم الشهر والسنة ونوع التقويم .

والدالة الأخرى تحتاج إلى تمرير التاريخ ونوع التقويم .

Function GetMonthDays_mmyy(ByVal mm As Byte, ByVal yy As Integer, ByVal Cal As Byte) As Byte

  Const Gregorian = 1

  Const Hijri = 2

  Const UmAlQura = 3

  Dim CurrCal As Byte

  

  On Error Resume Next

  

  GetMonthDays_mmyy = 0

  If Cal < 1 Or Cal > 3 Then Exit Function

  

  CurrCal = Calendar

  

  Select Case Cal

    Case Gregorian

      Calendar = vbCalGreg

      GetMonthDays_mmyy = Day(DateSerial(yy, mm + 1, 0))

    Case Hijri

      Calendar = vbCalHijri

      GetMonthDays_mmyy = 30 - Day(DateSerial(yy, mm + 1, 0)) Mod 30

    Case UmAlQura

      Do While mm < 1:  mm = mm + 12: yy = yy - 1: Loop

      Do While mm > 12: mm = mm - 12: yy = yy + 1: Loop

      Call LoadUmAlQura_Code

      If yy < LBound(UmAll) Or yy > UBound(UmAll) Then Exit Function

      GetMonthDays_mmyy = UmAll(yy).M2(mm) - UmAll(yy).M2(mm - 1)

  End Select

  

  Calendar = CurrCal

End Function



'---------------------------------------------------------------------

Function GetMonthDays_Date(ByVal InDate As Variant, Cal as Byte) As Byte

  Const Gregorian = 1

  Const Hijri = 2

  Const UmAlQura = 3

  Dim CurrCal As Byte

  Dim myDate As Date

  Dim mm As Byte

  Dim yy As Integer

   Dim Pos As Byte



  On Error Resume Next

  

  GetMonthDays_Date = 0

  If Cal < 1 Or Cal > 3 Then Exit Function

  

  CurrCal = Calendar

  

  Select Case Cal

    Case Gregorian

      Calendar = vbCalGreg

      myDate = CDate(InDate)

      GetMonthDays_Date = Day(DateSerial(Year(myDate), Month(myDate) + 1, 0))

    Case Hijri

      Calendar = vbCalHijri

      myDate = CDate(InDate)

      GetMonthDays_Date = 30 - Day(DateSerial(Year(myDate), Month(myDate) + 1, 0)) Mod 30

    Case UmAlQura

      Pos = InStr(1, InDate, "/")

      Select Case Pos

        Case 3: mm = Mid(InDate, 4, 2): yy = Mid(InDate, 7, 4)

        Case 5: mm = Mid(InDate, 6, 2): yy = Mid(InDate, 1, 4)

      End Select

      If mm < 1 Or mm > 12 Then Exit Function

      Call LoadUmAlQura_Code

      If yy < LBound(UmAll) Or yy > UBound(UmAll) Then Exit Function

      GetMonthDays_Date = UmAll(yy).M2(mm) - UmAll(yy).M2(mm - 1)

  End Select

  

  Calendar = CurrCal

End Function

تحياتي .