تاريخ يوم محدد فى السنه

تفضل اخي الكريم

 If (Weekday(Date, vbSunday) = 6) Then
   MsgBox "الجمعه"
ElseIf (Weekday(Date, vbSunday) = 7) Then
   MsgBox "السبت"
End If

السلام عليكم...

انسخ الدالة التالية و ضعها في Module

Public Function GetSimilarDays(ByVal ADay As VbDayOfWeek, ByVal StartDate As Date, ByVal EndDate As Date) As Variant
	Dim ADate As Date
	Dim FirstDayFound As Boolean
	Dim ResultArr() As Date
	Dim ResultCln As Collection
	Dim Index As Long

	GetSimilarDays = Null
	FirstDayFound = False
	ADate = StartDate
	Do
 	If Weekday(ADate, vbSunday) = ADay Then
 	FirstDayFound = True
 	Exit Do
 	End If
 	ADate = DateAdd("d", 1, ADate)
	Loop While (ADate <= EndDate) And (DateDiff("d", ADate, StartDate) < 7)

	If FirstDayFound Then
 	Set ResultCln = New Collection
 	Do
 	ResultCln.Add ADate
 	ADate = DateAdd("d", 7, ADate)
 	Loop While ADate <= EndDate
 	ReDim ResultArr(1 To ResultCln.Count) As Date
 	For Index = 1 To ResultCln.Count
 	ResultArr(Index) = ResultCln(Index)
 	Next Index
 	Set ResultCln = Nothing
 	GetSimilarDays = ResultArr
	End If
End Function

كما نلاحظ فإن الدالة تأخذ 3 بارامترات:

البارامتر الأول ADay و هو رقم اليوم من الأسبوع: 1 = الأحد، 2 = الاثنين، ... 7 = السبت. و يمكنك استعمال ثوابت VB مثل vbSunday و vbMonday ... إلخ.

البارامتر الثاني StartDate (نوعه Date) تاريخ بداية الفترة.

البارامتر الثالث EndDate (نوعه Date) تاريخ نهاية الفترة.

الدالة تعيد قيمة من النوع Variant عبارة عن مصفوفة تحتوي على التواريخ الواقعة بين (و تشمل) تاريخ البداية StartDate و تاريخ النهاية EndDate و التي توافق اليوم المحدد من الأسبوع ADay (الأحد، الاثنين، ... إلخ).

الدالة قد تعيد أيضاً NULL إذا لم يوجد اليوم المطلوب بين التاريخين المحددين.

مثال:

نفرض أن لدينا Text1 بها تاريخ البداية (01\12\2009 مثلاً) و Text2 بها تاريخ النهاية (31\12\2009 مثلاً) و List1 نريد أن نضع بها التواريخ الواقعة في يوم الثلاثاء ضمن هذه الفترة (شهر 12 في هذا المثال). إذن:

Private Sub Command1_Click()
	Dim DaysList As Variant
	Dim Idx As Long

	List1.Clear
	DaysList = GetSimilarDays(vbTuesday, CDate(Text1.Text), CDate(Text2.Text))
	If IsNull(DaysList) Then
 	MsgBox "لا توجد تواريخ تقع في اليوم المطلوب ضمن الفترة المحددة"
	Else
 	For Idx = LBound(DaysList) To UBound(DaysList)
 	List1.AddItem CStr(DaysList(Idx))
 	Next Idx
	End If
End Sub

نرجو الاستفادة و السلام.

اشكركم على الردود الجميلة سأجرب ولو فى حاجة تانى هستشيركم

جزاكم الله كل خير