كم جمعة في حياتك ؟

الأخوة الكرام

بعد التحية

هذه دالة لعد أي يوم من الأسبوع لفترة محددة

مدخلاتها :

1 - بداية الفترة

2 - نهاية الفترة

3 - رقم اليوم في الإسبوع علما أن الأسبوع يبدأ بيوم الأحد ورقمه 1 وينتهي بيوم السبت ورقمه 7 .

Function CountWkDay(DateFm, DateTo As Variant, WkDay As Byte) As Variant

  Dim DFm, DTo As Long

  Dim WDStr, Days As String

  

  CountWkDay = Null

  If WkDay < 1 Or WkDay > 7 Then Exit Function

  If IsNull(DateFm) And IsNull(DateTo) Then Exit Function

  If Not IsDate(DateFm) And Not IsDate(DateTo) Then Exit Function

  

  If IsNull(DateFm) Then DateFm = DateTo

  If IsNull(DateTo) Then DateTo = DateFm

  

  If Not IsDate(DateFm) Then DateFm = DateTo

  If Not IsDate(DateTo) Then DateTo = DateFm

  

  If DateFm > DateTo Then

    DFm = DateFm

    DateFm = DateTo

    DateTo = DFm

  End If

  

  WDStr = Format(WkDay, "dddd") & " "

  

  DFm = DateFm - 1

  DTo = DateTo

  DFm = Fix((DFm + (7 - WkDay)) / 7)

  DTo = Fix((DTo + (7 - WkDay)) / 7)

  

  If DTo - DFm > 1 Then Days = " days" Else Days = " day"

  

  CountWkDay = WDStr & DTo - DFm & Days

End Function

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

'هذا إجراء يوضح كيفية استخدام الدالة والاستفادة منه

Sub How2Use_CountWkDay()

  Dim FmDate As Variant

  Dim ToDate As Variant

  Dim K As Byte

  

  FmDate = CDate(DateSerial(2001, 10, 1))

  ToDate = CDate(DateSerial(2001, 10, 31))

  

  For K = vbSunday To vbSaturday

    MsgBox Nz(CountWkDay(FmDate, ToDate, K))

  Next K

End Sub

آمل أن يحوز على رضاكم