السلام عليكم
استاذ صباح
هذا شرح مبسط لاجزاء للكود عامتا
Sub dahmour_go()
Application.ScreenUpdating = False
'هذه الفقرة لمحو البيانات القديمة ان وجدت و تعديل عدد ايام الشهر
x = Cells(Rows.Count, 1).End(xlUp).Row
If x > 5 Then Range("a6:ag" & x).ClearContents
Range("ad5:ag5").ClearContents
m = Day(DateSerial([b2], [b3] + 1, 0))
For x = 28 To m
Cells(5, x + 2) = x
Next
'هذه الفقرة للاستعلام من الاكسيس و استخراج كود الموظف و اسمه بدون تكرار بشرط ان اجازاته تقع في الشهر المراد الاستعلام عنه
Dim rsData As ADODB.Recordset
Dim sConnect As String
Dim sSQL As String
sConnect = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ActiveWorkbook.Path & "\" & [b1] & ".mdb;Persist Security Info=True "
sSQL = "select distinct x.emb_id,emb_name from ejazat as x,nformation as y where x.emb_id=y.emb_id and month(from_day)=" & [b3] & " and year(from_day)=" & [b2] & " or (x.emb_id=y.emb_id and month(from_day)<" & [b3] & " and month(from_day+moda_ejaza)>=" & [b3] & " and year(from_day)=" & [b2] & " ) or (x.emb_id=y.emb_id and month(from_day)>" & [b3] & " and month(from_day+moda_ejaza)>=" & [b3] & " and year(from_day)<" & [b2] & " and year(from_day+moda_ejaza)=" & [b2] & " ) order by x.emb_id"
Set rsData = New ADODB.Recordset
rsData.Open sSQL, sConnect, adOpenForwardOnly, _
adLockReadOnly, adCmdText
If Not rsData.EOF Then
[a6].CopyFromRecordset rsData
'هذه الفقرة لاستخراج كود الموظف و اسمه و نوع الاجازة و تاريخ البداية و عدد الايام و تاريخ النهاية
'بشرط ان اجازاته تقع في الشهر المراد الاستعلام عنه
' و هذه البيانات مؤقتة لحساب التقرير و تمحى في اخر الكود
sSQL = "select x.emb_id,emb_name,ejaza_type,from_day,moda_ejaza,from_day+moda_ejaza from ejazat as x,nformation as y where x.emb_id=y.emb_id and month(from_day)=" & [b3] & " and year(from_day)=" & [b2] & " or (x.emb_id=y.emb_id and month(from_day)<" & [b3] & " and month(from_day+moda_ejaza)>=" & [b3] & " and year(from_day)=" & [b2] & " ) or (x.emb_id=y.emb_id and month(from_day)>" & [b3] & " and month(from_day+moda_ejaza)>=" & [b3] & " and year(from_day)<" & [b2] & " and year(from_day+moda_ejaza)=" & [b2] & " ) order by x.emb_id,from_day"
Set rsData = New ADODB.Recordset
rsData.Open sSQL, sConnect, adOpenForwardOnly, _
adLockReadOnly, adCmdText
If Not rsData.EOF Then
[ah6].CopyFromRecordset rsData
rsData.Close
End If
'********************************************************
'هنا كود لتحويل البيانات الي شكل التقرير النهائي
For i = 6 To Cells(Rows.Count, 1).End(xlUp).Row
For n = 6 To Cells(Rows.Count, "ah").End(xlUp).Row
If Cells(i, 1) = Cells(n, 34) Then
For Each c In Range("c5:ag5")
If Not IsEmpty(c) Then
If DateSerial([b2], [b3], c.Value) >= Cells(n, 37) And DateSerial([b2], [b3], c.Value) <= Cells(n, 39) Then
Cells(i, c.Column) = Cells(n, 36).Value
End If
End If
Next
End If
Next
Next
'*************************************************************
Range("ah6:am" & Cells(Rows.Count, "ah").End(xlUp).Row).Clear
End If
Application.ScreenUpdating = True
End Sub
اولا يمكن زيادة عمود departmen لكن سيلزم التعديل في باقي اجزاء الكود .
ثانيا بالنسبة لجملة sql فتعتمد علي استخراج البيانات ان كان تاريخ بداية الاجازة في الشهر الحالي و السنة الحالية
او تاريخ بداية الاجازة في شهر سابق و في السنة الحالية و تاريخ نهاية الاجازة اكبر من او يساوي الشهر الحالي
او تاريخ بداية الاجازة في سنة سابقة و تاريخ نهاية الاجازة يقطع الشهر الحالي للسنة الحالية
ملاحظة الشهر الحالي اي الشهر المراد البحث بدللالته .
تحياتي