logo

لوحة التميز الأسبوعي
العضو المتميز المشرف المتميز المراقب المتميز المدير المتميز الموضوع المتميز القسم المتميز
العضو المتميز المشرف المتميز المراقب المتميز المدير المتميز الموضوع المتميز القسم المتميز
Hatem Eissa hassona229-- لا تميز خلال هذه الفترة لا تميز خلال هذه الفترة لا تميز خلال هذه الفترة اكسيل مشاريع جاهزه



أهلا وسهلا بك زائرنا الكريم في أكاديمية الصقر للتدريب، لكي تتمكن من المشاركة ومشاهدة جميع أقسام المنتدى وكافة الميزات ، يجب عليك إنشاء حساب جديد بالتسجيل بالضغط هنا أو تسجيل الدخول اضغط هنا إذا كنت عضواً .





29-08-2018 06:05 مساءً
معلومات الكاتب ▼
تاريخ الإنضمام : 22-08-2017
رقم العضوية : 43
المشاركات : 853
الجنس :
تاريخ الميلاد : 1-5-1989
الدعوات : 1
قوة السمعة : 6611
الاعجاب : 2
قي هذا الملف
1-حدد تاريخ البداية وتاريخ النهاية
2- حدد ايام التعطيل العادية (جمعة سبت.......)
3 حدد تواريخ العطل الرسمية او القسرية (أعياد مناسبات.....)
4- أضغط على الزر
ملاحظة:حسب تظام الجهاز قد تكتب التواريخ بصيغة dd/mm/yyy (نظام انكليزي) او mm/dd/yyy ( نظام اميركي)
الكود
CODE

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


الملف مرفق
 
 
  Works_Days.rar   تحميل rar مرات التحميل :(40)
الحجم :(164.864) KB





look/images/icons/i1.gif معرفة ايام العمل بين تاريخين
  29-08-2018 10:06 مساءً   [1]
معلومات الكاتب ▼
تاريخ الإنضمام : 03-10-2017
رقم العضوية : 852
المشاركات : 1580
الدولة : مصر
الجنس :
تاريخ الميلاد : 1-9-1995
الدعوات : 5
قوة السمعة : 10861
الاعجاب : 6
موقعي : زيارة موقعي
جزاك الله خيرا استاذ سليم
واصل بلا فواصل 142




look/images/icons/i1.gif معرفة ايام العمل بين تاريخين
  29-08-2018 11:11 مساءً   [2]
معلومات الكاتب ▼
تاريخ الإنضمام : 20-11-2017
رقم العضوية : 1757
المشاركات : 1765
الدولة : مصر
الجنس :
الدعوات : 2
قوة السمعة : 9685
الاعجاب : 25
أحسنت استاذ سليم بارك الله فيك وجزاك الله كل خير



توقيع :ali mohamed ali


{ وَقُل رَّبِّ زِدْنِي عِلْمًا }
[ كن على يقين من اعمالنا نخطئ ومن اخطائنا نتعلم ولذلك لا شي مستحيل ]
ساهم دائماً فى حل أى مشكلة او أستفسار لديك مع إضافة رد بشكره
أو دعوة لمن قدم اليك المساعدة,فالجميع هنا يعمل على مساعدة
الاخرين لوجه الله وان تحتسب له اجر عند الله

look/images/icons/i1.gif معرفة ايام العمل بين تاريخين
  30-08-2018 07:11 صباحاً   [3]
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 10529
الجنس :
تاريخ الميلاد : 1-10-1978
الدعوات : 24
قوة السمعة : 36759
الاعجاب : 186
بارك الله فيك أخي العزيز سليم وجزاك الله خيراً




look/images/icons/i1.gif معرفة ايام العمل بين تاريخين
  14-11-2018 08:46 صباحاً   [4]
معلومات الكاتب ▼
تاريخ الإنضمام : 17-01-2018
رقم العضوية : 3730
المشاركات : 291
الجنس :
تاريخ الميلاد : 13-9-1973
الدعوات : 2
قوة السمعة : 2222
الاعجاب : 5
جزاك الله كل خير




look/images/icons/i1.gif معرفة ايام العمل بين تاريخين
  20-11-2018 07:42 مساءً   [5]
معلومات الكاتب ▼
تاريخ الإنضمام : 04-09-2017
رقم العضوية : 346
المشاركات : 32
الدولة : مصر
الجنس :
تاريخ الميلاد : 25-10-1981
قوة السمعة : 115
الاعجاب : 0
بارك الله فيك اخى الحبيب وجزاكم الله خير




اضافة رد جديد اضافة موضوع جديد



المواضيع المتشابهه
عنوان الموضوع الكاتب الردود الزوار آخر رد
ايام العمل salim
9 2231 starta

الكلمات الدلالية
معرفة ، ايام ، العمل ، تاريخين ،









اخلاء مسئولية: يخلى منتدى أكاديمية الصقر للتدريب مسئوليته عن اى مواضيع او مشاركات تندرج داخل الموقع ويحثكم على التواصل معنا ان كانت هناك اى إنتهاكات تتضمن اى انتهاك لحقوق الملكية الفكرية او الادبية لاى جهة - بالتواصل معنا من خلال نموذج مراسلة الإدارة .وسيتم اتخاذ الاجراءات اللازمة.
سياسة النشر: التعليقات المنشورة لا تعبر عن رأي منتدى أكاديمية الصقر للتدريب ولا نتحمل أي مسؤولية قانونية حيال ذلك ويتحمل كاتبها مسؤولية النشر.

الساعة الآن 01:04 AM