قي هذا الملف
1-حدد تاريخ البداية وتاريخ النهاية
2- حدد ايام التعطيل العادية (جمعة سبت.......)
3 حدد تواريخ العطل الرسمية او القسرية (أعياد مناسبات.....)
4- أضغط على الزر
ملاحظة:حسب تظام الجهاز قد تكتب التواريخ بصيغة dd/mm/yyy (نظام انكليزي) او mm/dd/yyy ( نظام اميركي)
الكود

Option Explicit
Sub give_date()
If ActiveSheet.Name <> "Main" Then GoTo Exit_Me
 With Application
  .ScreenUpdating = False
  .Calculation = xlCalculationManual
 End With
Dim t1 As Date: t1 = [b2]
Dim t2 As Date: t2 = [b3]
Dim Laste_Used_Col%: Laste_Used_Col = Cells(10, Columns.Count).End(1).Column
If Laste_Used_Col < 8 Then Laste_Used_Col = 8
Dim intreval%: intreval = t2 - t1 + 1
Dim My_Date As Date
Dim x$, xx%, i%, s%
Dim k%, r%, c%, t%, Z%, y%: r = 10: c = 8
Dim Final_col%
Dim lset_col%: lset_col = Cells(2, Columns.Count).End(1).Column
Dim rg_to_out As Range: Set rg_to_out = Range("i2").Resize(1, lset_col - 8)
Dim Normal_range As Range: Set Normal_range = Range("h2:h7")
Dim arab_day(1 To 7)
 arab_day(1) = "الأحد": arab_day(2) = "الإثنين": arab_day(3) = "الثلاثاء"
 arab_day(4) = "الأربعاء": arab_day(5) = "الخميس": arab_day(6) = "الجمعة"
 arab_day(7) = "السّبت"
Dim Eng_day(1 To 7)
 Eng_day(1) = "Sun": Eng_day(2) = "Mon": Eng_day(3) = "Tue": Eng_day(4) = "Wed"
 Eng_day(5) = "Thu": Eng_day(6) = "Fri": Eng_day(7) = "Sat"
Dim arab_month(1 To 12)
 arab_month(1) = "كانون الثّاني": arab_month(2) = "شباط": arab_month(3) = "آذار": arab_month(4) = "نيسان"
 arab_month(5) = "أيّار": arab_month(6) = "حزيران": arab_month(7) = "تـمّوز"
 arab_month(8) = "آب": arab_month(9) = "أيلول": arab_month(10) = "تشرين الأوّل"
 arab_month(11) = "تشرين الثّاني": arab_month(12) = "كانون الأوّل"
Dim Eng_Month(1 To 12)
   Eng_Month(1) = "Jan": Eng_Month(2) = "Feb": Eng_Month(3) = "Mar": Eng_Month(4) = "Apr"
   Eng_Month(5) = "May": Eng_Month(6) = "Jun": Eng_Month(7) = "Jul": Eng_Month(8) = "Aug"
   Eng_Month(9) = "Sep": Eng_Month(10) = "Oct": Eng_Month(11) = "Nov": Eng_Month(12) = "Dec"
   '========================================
   Range("h8").Resize(2, Laste_Used_Col - 7).Clear
   Range("h10:bz40").ClearContents
      '===============================
   My_Date = t1
  For k = 1 To intreval
   xx = Application.Match(Format(My_Date, "ddd"), Eng_day, 0)
   x = arab_day(xx)
y = Application.CountIf(Normal_range, x)
Z = Application.CountIf(rg_to_out, My_Date)
        If y + Z = 0 Then
            Cells(r, c) = My_Date: Cells(r, c + 1) = x
            r = r + 1
            s = s + 1
        End If
        If Month(My_Date) <> Month(My_Date + 1) Then r = 10: c = c + 2
        My_Date = My_Date + 1
     Next
     
     '==========================================
     Final_col = Cells(10, Columns.Count).End(1).Column
      If Final_col < 8 Then Final_col = 8
     For i = 8 To Final_col Step 2
       Cells(9, i) = arab_month(Month(Cells(9, i).Offset(1, 0)))
       Cells(9, i + 1) = Year(Cells(9, i).Offset(1, 0))
       Cells(8, i) = Application.Count(Range(Cells(10, i), Cells(45, i)))
     Next
     With Range("H8").Resize(2, Final_col - 7)
       With .Borders
        .LineStyle = 1
        .Weight = xlMedium
      End With
      With .Font
     .Name = "Arabic Typesetting"
     .Bold = True
     End With
     .HorizontalAlignment = xlCenter
     .Interior.ColorIndex = 6
     End With
     Range("j6") = s
     '=========================================
Exit_Me:
Erase arab_day: Erase Eng_day: Erase arab_month: Erase Eng_Month
   With Application
  .ScreenUpdating = True
  .Calculation = xlCalculationAutomatic
 End With
End Sub

الملف مرفق