اذهب الي المحتوي
أوفيسنا

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

قام بنشر (معدل)

تحية طيبة ... وبعد.

ارجو التكرم المساعدة في طباعة الشيت خلال شهر معين بأن يتم طباعة جميع التواريخ الشهري ماعدا تواريخ التي توافق يوم الجمعة ( او الجمعة و السبت ).

وشكرا

حضور و انصراف.xlsx

تم تعديل بواسطه محمد غطفان
قام بنشر (معدل)

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

تم تعديل بواسطه محمد غطفان
  • 2 weeks later...
قام بنشر (معدل)

بحمد الله توصلت الى ما كنت ابتغيه

واصبح بالامكان اختيار بداية و نهاية التاريخ
وتحديد الايام المستثنيه من الطباعه
واضافه رسالة خطأ عند ادخال تاريخ البدايه اكبر من النهاية
و المعاينة قبل الطباعه و التأكيد على الاستمرار في الطباعه ام لا

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

احببت ان اشارككم الملف للفائده

وشكرا

حضور و انصراف 5 ‬.xlsm

تم تعديل بواسطه محمد غطفان
قام بنشر

الكود بهذا الشكل اسرع    ولا لزوم لهذه الكمية الكبيرة من الشروط  IF    الشروط للوصول الى نتيجة عددها 14



Sub copy_date()

Application.ScreenUpdating = False

Dim start_date As Date: start_date = DateSerial([Q3], [P3], [O3])
Dim end_enter As Date: end_enter = DateSerial([Q4], [P4], [O4])
Dim end_date As Integer: end_date = [O5]
Dim my_date As Date
Dim x
If start_date <= end_enter Then GoTo 1

MsgBox " ادخلت تاريخ البداية  " & Range("Q3").Text & "/" & Range("p3").Text & "/" & Range("o3").Text & "  يجب تاريخ النهاية يكون مساوي او اكبر من تاريخ البداية "

GoTo 2

1:

'ActiveWindow.SelectedSheets.PrintPreview
A = MsgBox("هل تود الطباعة بعد المعاينة ؟", vbYesNo + vbQuestion, "طباعة")
If A = vbNo Then GoTo 2
Dim i%

For i = 0 To end_date - 1
  my_date = start_date + i
  If IsError(Application.Match(Weekday(my_date), Range("O9:O15"), 0)) Then
   Cells(3, "h") = my_date: Cells(3, "F") = Weekday(my_date)
   Cells(3, "F").NumberFormat = ("DDDD")
   ActiveWindow.SelectedSheets.PrintOut
  End If
 Next
2:
Application.ScreenUpdating = True

End Sub

  

 

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

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

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information