موقف غباب موظفين يومي وشهري

[mohanad2025]

السلام عليكم .. ممكن كود او معادلة يقوم بإظهار نتائج الغياب اليومي والشهري للموظفين .. الشرح داخل المصنف جزاكم الله خيرا

موقف غياب موظفين.xlsm

[Abaas]

للرفع

[Foksh]

8 ساعات مضت, Abaas said:

للرفع

تفضل أخي الكريم ، محاولتي البسيطة . حيث في الورقة الثانية = موقف الغياب اليومي ، قمت بإضافة زر للتحديث ، وتم استدعاءه للدالة التي تم انشاؤها في مديول عام :-

Sub ExtractAbsentEmployees()
    Dim wsMain As Worksheet
    Dim wsReport As Worksheet
    Dim targetDate As Date
    Dim dayNum As Integer
    Dim targetCol As Integer
    Dim lastRow As Long
    Dim i As Long
    Dim reportRow As Long
    
    Set wsMain = ThisWorkbook.Sheets("MainSheet")
    Set wsReport = ThisWorkbook.Sheets("موقف الغياب اليومي")
    
    wsReport.Range("A5:D" & wsReport.Rows.Count).ClearContents
    
    targetDate = wsReport.Range("C2").Value
    dayNum = Day(targetDate)
    
    targetCol = 3 + dayNum
    
    If targetCol < 4 Or targetCol > 34 Then
        MsgBox ".تاريخ غير صالح يجب أن يكون اليوم بين 1 و 31", vbExclamation
        Exit Sub
    End If
    
    lastRow = wsMain.Cells(wsMain.Rows.Count, "B").End(xlUp).Row
    
    reportRow = 5
    
    For i = 4 To lastRow
        If wsMain.Cells(i, targetCol).Value = "غ" Then
            wsReport.Cells(reportRow, 1).Value = wsMain.Cells(i, 1).Value
            wsReport.Cells(reportRow, 2).Value = wsMain.Cells(i, 2).Value
            wsReport.Cells(reportRow, 3).Value = wsMain.Cells(i, 3).Value
            wsReport.Cells(reportRow, 4).Value = targetDate
            reportRow = reportRow + 1
        End If
    Next i
    
    If reportRow = 5 Then
        MsgBox "لا يوجد موظفين متغيبين في هذا التاريخ", vbInformation
    End If
End Sub

 

وفي الورقة الثالثة "موقف الغياب الشهري" ، أيضاً تم انشاء زر لاستدعاءه الدالة التالية من نفس المديول :-

Sub GenerateMonthlyAbsenceReport()
    Dim wsMain As Worksheet
    Dim wsReport As Worksheet
    Dim startDate As Date, endDate As Date
    Dim currentDate As Date
    Dim dayNum As Integer, targetCol As Integer
    Dim lastRow As Long, reportRow As Long, i As Long
    Dim empName As String, empJob As String
    Dim dateList As String, dayList As String
    Dim dateCount As Integer
    Dim dayName As String
    
    Set wsMain = ThisWorkbook.Sheets("MainSheet")
    Set wsReport = ThisWorkbook.Sheets("موقف الغياب الشهري")
    
    If Not IsDate(wsReport.Range("C2").Value) Or Not IsDate(wsReport.Range("C3").Value) Then
        MsgBox "الرجاء إدخال تاريخين صالحين في الخلايا C2 و C3", vbExclamation + vbMsgBoxRight, ""
        Exit Sub
    End If
    
    startDate = wsReport.Range("C2").Value
    endDate = wsReport.Range("C3").Value
    
    If startDate > endDate Then
        MsgBox "خطأ: تاريخ البداية يجب أن يكون قبل تاريخ النهاية", vbExclamation + vbMsgBoxRight, ""
        Exit Sub
    End If
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    With wsReport
        .Range("A6:F" & .Rows.Count).ClearContents
        .Range("6:" & .Rows.Count).RowHeight = 15
    End With
    
    lastRow = wsMain.Cells(wsMain.Rows.Count, "B").End(xlUp).Row
    reportRow = 6
    
    For i = 4 To lastRow
        empName = wsMain.Cells(i, 2).Value
        empJob = wsMain.Cells(i, 3).Value
        
        If empName = "" Then GoTo NextEmployee
        
        dateList = ""
        dayList = ""
        dateCount = 0
        
        currentDate = startDate
        Do While currentDate <= endDate
            dayNum = Day(currentDate)
            targetCol = 3 + dayNum
            
            If targetCol >= 4 And targetCol <= 34 Then
                If wsMain.Cells(i, targetCol).Value = "غ" Then
                    dayName = wsMain.Cells(2, targetCol).Value
                    
                    If dateList <> "" Then
                        dateList = dateList & vbLf & Format(currentDate, "yyyy-mm-dd")
                        dayList = dayList & vbLf & dayName
                    Else
                        dateList = Format(currentDate, "yyyy-mm-dd")
                        dayList = dayName
                    End If
                    dateCount = dateCount + 1
                End If
            End If
            
            currentDate = DateAdd("d", 1, currentDate)
        Loop
        
        If dateCount > 0 Then
            With wsReport
                .Cells(reportRow, 1).Value = reportRow - 5
                .Cells(reportRow, 2).Value = empName
                .Cells(reportRow, 3).Value = empJob
                .Cells(reportRow, 4).Value = dateCount
                .Cells(reportRow, 5).Value = dateList
                .Cells(reportRow, 6).Value = dayList
                
                .Cells(reportRow, 5).WrapText = True
                .Cells(reportRow, 6).WrapText = True
                
                If dateCount > 1 Then
                    .Rows(reportRow).RowHeight = 15 * dateCount
                End If
            End With
            
            reportRow = reportRow + 1
        End If
        
NextEmployee:
    Next i
    
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    
    If reportRow > 6 Then
'        MsgBox "تم إنشاء التقرير بنجاح", vbInformation + vbMsgBoxRight, ""
    Else
        MsgBox "لا توجد أيام غياب في الفترة المحددة", vbInformation + vbMsgBoxRight, ""
    End If
End Sub

 

وتركت لك التعديل متاحاً من خلال تحديد الصف أو العمود ... إلخ . وهذا ملفك بعد التعديل . راجعه وأخبرنا بالنتيجة  ..

 

 

 

موقف غياب موظفين.zip

[mohanad2025]

كل الشكر للاخ المحترم foksh...جزاك الله خيرا لمساعدتي