نجوم المشاركات

السلام عليكم ورحمة الله وبركاته الكود Sub CheckAbsence() Dim ws As Worksheet Dim lastRow As Long, i As Long, j As Long Dim countConsecutive As Long, maxConsecutive As Long Dim countTotal As Long Dim msg As String Dim cell As Range Set ws = ThisWorkbook.Sheets("ورقة1") lastRow = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row For i = 2 To lastRow countConsecutive = 0 maxConsecutive = 0 countTotal = 0 ' المرور على نطاق الغياب C:AG For Each cell In ws.Range("C" & i & ":AG" & i) If cell.Value = "غ" Then countConsecutive = countConsecutive + 1 countTotal = countTotal + 1 If countConsecutive > maxConsecutive Then maxConsecutive = countConsecutive End If Else countConsecutive = 0 End If Next cell msg = "" If maxConsecutive >= 15 Then msg = "مفصول" ElseIf maxConsecutive >= 5 Then msg = "إنذار أول" End If If countTotal >= 30 Then msg = "مفصول" ElseIf countTotal >= 24 Then msg = "إنذار ثالث" ElseIf countTotal >= 16 Then msg = "إنذار ثاني" ElseIf countTotal >= 8 And msg = "" Then msg = "إنذار أول" End If ws.Cells(i, "AH").Value = msg Next i End Sub الملف سجل غياب الطلاب1.xlsb

جرب هذا SELECT TB1.SAMEE FROM TB1 LEFT JOIN TB2 ON TB1.SAMEE = TB2.SAMEE WHERE TB2.SAMEE IS NULL;

السلام عليكم كود طباعة وكود تحويل pdf Sub Print_Managers_Deputies() Dim wsData As Worksheet, wsReport As Worksheet Dim lastRow As Long, i As Long Dim idVal As String, roleVal As String Application.ScreenUpdating = False Application.EnableEvents = False Set wsData = ThisWorkbook.Sheets("data") Set wsReport = ThisWorkbook.Sheets("التقرير مدير وكيل") lastRow = wsData.Cells(wsData.Rows.Count, "A").End(xlUp).Row For i = 3 To lastRow idVal = wsData.Cells(i, "A").Value roleVal = wsData.Cells(i, "E").Value If (InStr(1, roleVal, "مدير", vbTextCompare) > 0) _ Or (InStr(1, roleVal, "وكيل", vbTextCompare) > 0) Then wsReport.Range("L2").Value = idVal wsReport.PrintOut wsReport.Range("L2").Value = 1 End If Next i MsgBox "تمت طباعة جميع المديرين والوكلاء.", vbInformation Application.ScreenUpdating = True Application.EnableEvents = True End Sub Sub sav_PDFall2() Dim wsData As Worksheet, wsReport As Worksheet Dim lastRow As Long, i As Long Dim roleVal As String Dim folderPath As String, pdfPath As String Dim safeName As String Application.ScreenUpdating = False Application.EnableEvents = False Set wsData = ThisWorkbook.Sheets("data") Set wsReport = ThisWorkbook.Sheets("التقرير مدير وكيل") wsReport.Unprotect password:="0" folderPath = ThisWorkbook.Path & "\التقرير مدير وكيل" If Dir(folderPath, vbDirectory) = "" Then MkDir folderPath lastRow = wsData.Cells(wsData.Rows.Count, "A").End(xlUp).Row For i = 3 To lastRow roleVal = wsData.Cells(i, "E").Value If (InStr(1, roleVal, "مدير", vbTextCompare) > 0) _ Or (InStr(1, roleVal, "وكيل", vbTextCompare) > 0) Then wsReport.Range("C9").Value = wsData.Cells(i, "B").Value safeName = wsReport.Range("C9").Value safeName = Replace(safeName, "/", "-") safeName = Replace(safeName, "\", "-") safeName = Replace(safeName, ":", "-") safeName = Replace(safeName, "*", "-") safeName = Replace(safeName, "?", "-") safeName = Replace(safeName, """", "-") safeName = Replace(safeName, "<", "-") safeName = Replace(safeName, ">", "-") safeName = Replace(safeName, "|", "-") pdfPath = folderPath & "\" & safeName & ".pdf" wsReport.ExportAsFixedFormat _ Type:=xlTypePDF, _ Filename:=pdfPath, _ Quality:=xlQualityMinimum, _ IncludeDocProperties:=True, _ IgnorePrintAreas:=False, _ OpenAfterPublish:=False End If Next i MsgBox "تم حفظ جميع ملفات PDF للمديرين والوكلاء في:" & vbCrLf & folderPath, vbInformation wsReport.Protect password:="0" Application.ScreenUpdating = True Application.EnableEvents = True End Sub الملف طباعة وظائف محددة.xlsm

وعليكم السلام ورحمة الله وبركاته تم انشاء كود الطباعة والمعاينة اتمنى ان تجد في الحل طلبك لك وافر الاحترام Sub Print_All_Employees() Dim ws As Worksheet Dim cell As Range Dim rng As Range Set ws = ThisWorkbook.Sheets("إداريين") Set rng = ws.Range("C3:C137") Application.ScreenUpdating = False For Each cell In rng If cell.Value <> "" Then ws.Range("CQ6").Value = cell.Value ws.PageSetup.PrintArea = "CP5:CY47" ws.PrintOut End If Next cell ws.Range("CQ6").Value = rng.Cells(1, 1).Value Application.ScreenUpdating = True MsgBox "تمت طباعة جميع الموظفين بنجاح.", vbInformation End Sub طباعة الكل بضغطة.xlsm