mahmoud nasr alhasany

تفضل هذا الملف ليس من اعدادى ولاكن من اعداد المحاسب وائل مراد والدعاء له برنامج حضور وإنصراف.xlsالدليل المصور للتعامل مع البرنامج.doc

تفضل جرب هذا Employees Form-unprotected - Copy.xlsm

تفضل جرب هذا الحل باستخدام المعادلات مباشرة في الخلايا: يمكنك وضع المعادلات التالية مباشرة في الخلايا المطلوبة في ورقة "Sheet10": الخلية C3: =G4 الخلية E3: =IF(EOMONTH(C3,6)>G5,G5,EOMONTH(C3,6)) الخلية C4: =E3+1 الخلية E4: =IF(EOMONTH(C4,6)>G5,G5,EOMONTH(C4,6)) الخلية C5: =E4+1 الخلية E5: =IF(EOMONTH(C5,6)>G5,G5,EOMONTH(C5,6)) الخلية C6: =E5+1 الخلية E6: =IF(EOMONTH(C6,6)>G5,G5,EOMONTH(C6,6)) الخلية C7: =E6+1 الخلية E7: =IF(EOMONTH(C7,6)>G5,G5,EOMONTH(C7,6)) الخلية C8: =E7+1 الخلية E8: =IF(EOMONTH(C8,6)>G5,G5,EOMONTH(C8,6)) الخلية C9: =E8+1 الخلية E9: =IF(EOMONTH(C9,6)>G5,G5,EOMONTH(C9,6)) الخلية C10: =E9+1 الخلية E10: =IF(EOMONTH(C10,6)>G5,G5,EOMONTH(C10,6)) شرح المعادلات: EOMONTH(date, months): تقوم هذه الدالة بإرجاع تاريخ نهاية الشهر الذي يقع قبل أو بعد عدد محدد من الأشهر من تاريخ البداية. في حالتنا، نضيف 6 أشهر إلى التاريخ الموجود في العمود C للحصول على نهاية شهر يونيو التالي. IF(logical_test, value_if_true, value_if_false): تقوم هذه الدالة بفحص شرط معين. إذا كان الشرط صحيحًا، فإنها ترجع القيمة الأولى؛ وإلا فإنها ترجع القيمة الثانية. في حالتنا، نتحقق مما إذا كان تاريخ نهاية يونيو أكبر من القيمة الموجودة في الخلية G5. إذا كان أكبر، نكتب قيمة G5؛ وإلا، نكتب تاريخ نهاية يونيو. ملاحظات: تأكد من أن ورقة العمل التي تريد تطبيق الكود أو المعادلات عليها اسمها "Sheet10" بالضبط. إذا كان اسمها مختلفًا، فقم بتعديل اسم الورقة في كود VBA أو عند الإشارة إلى الخلايا في المعادلات. في كود VBA، يتم تنفيذ كل سطر برمجي بشكل منفصل كما طلبت. باستخدام المعادلات، ستتحدث الخلايا تلقائيًا عند تغيير القيم في الخلايا التي تعتمد عليها (مثل G4 أو الخلايا في العمود C). اختر الطريقة التي تناسب احتياجاتك بشكل أفضل. إذا كنت بحاجة إلى تشغيل هذه العمليات بشكل متكرر أو كجزء من عملية أكبر، فقد يكون كود VBA أكثر ملاءمة. أما إذا كانت العملية تتم مرة واحدة أو كنت تفضل عدم استخدام وحدات الماكرو، فإن استخدام المعادلات مباشرة في الخلايا هو خيار جيد. Sub FillCells() Dim ws As Worksheet Set ws = ThisWorkbook.Sheets("ورقة 10") ' تعيين قيمة الخلية C3 ws.Range("C3").Value = ws.Range("G4").Value ' تعيين معادلة الخلية E3 ws.Range("E3").Formula = "=IF(EOMONTH(C3,6)>G5,G5,EOMONTH(C3,6))" ' تعيين قيمة الخلية C4 ws.Range("C4").Value = ws.Range("E3").Value + 1 ' تعيين معادلة الخلية E4 ws.Range("E4").Formula = "=IF(EOMONTH(C4,6)>G5,G5,EOMONTH(C4,6))" ' تعيين قيمة الخلية C5 ws.Range("C5").Value = ws.Range("E4").Value + 1 ' تعيين معادلة الخلية E5 ws.Range("E5").Formula = "=IF(EOMONTH(C5,6)>G5,G5,EOMONTH(C5,6))" ' تعيين قيمة الخلية C6 ws.Range("C6").Value = ws.Range("E5").Value + 1 ' تعيين معادلة الخلية E6 ws.Range("E6").Formula = "=IF(EOMONTH(C6,6)>G5,G5,EOMONTH(C6,6))" ' تعيين قيمة الخلية C7 ws.Range("C7").Value = ws.Range("E6").Value + 1 ' تعيين معادلة الخلية E7 ws.Range("E7").Formula = "=IF(EOMONTH(C7,6)>G5,G5,EOMONTH(C7,6))" ' تعيين قيمة الخلية C8 ws.Range("C8").Value = ws.Range("E7").Value + 1 ' تعيين معادلة الخلية E8 ws.Range("E8").Formula = "=IF(EOMONTH(C8,6)>G5,G5,EOMONTH(C8,6))" ' تعيين قيمة الخلية C9 ws.Range("C9").Value = ws.Range("E8").Value + 1 ' تعيين معادلة الخلية E9 ws.Range("E9").Formula = "=IF(EOMONTH(C9,6)>G5,G5,EOMONTH(C9,6))" ' تعيين قيمة الخلية C10 ws.Range("C10").Value = ws.Range("E9").Value + 1 ' تعيين معادلة الخلية E10 ws.Range("E10").Formula = "=IF(EOMONTH(C10,6)>G5,G5,EOMONTH(C10,6))" End Sub المصنف (155).xlsm

تفضل جرب هذا ورجاء ادخال مسارات الصورة فى العمود 10 فى شيت DbSheet او من خلال تحديد الاسم فى السجل داخل الليست بوكس وادخال الصورة المدرجة الخاصة بالموظف منظومة-الشؤون-الادارية - Copy - Copy.xlsm

بعد اذن استاذنا المتألق دائما / محمد هشام. تم اضافة المسلسل تلقائى وتم تسجيل تاريخ ووقت التعديل واسم المستخدم تلقائيًا عند تعديل أي سجل في جدول البيانات الخاص بك. فى العمود 8 والعمود 9 منظومة-الشؤون-الادارية - Copy.xlsm

تفضل جرب هذا الحدث Sub CreateNextMonthSheetAndLockOfficialHolidays() ' تسريع الكود Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Application.DisplayAlerts = False Dim ws As Worksheet, copiedSheet As Worksheet, monthTable As Worksheet, dataSheet As Worksheet Dim currentMonth As String, nextMonth As String, nextMonthArabic As String Dim i As Integer, foundRow As Range Dim dateCell As Range, checkDate As Date Dim holidayRange As Range, holidayCell As Cell Dim col As Range Dim isHoliday As Boolean Dim colNum As Long Dim weekdayNum As Integer Dim lockedText As String ' إعداد الشيتات Set ws = ActiveSheet Set monthTable = ThisWorkbook.Sheets("MonthNames") Set dataSheet = ThisWorkbook.Sheets("data") currentMonth = ws.Name ' جلب النص من MonthNames!H1 lockedText = monthTable.Range("H1").Value ' البحث عن اسم الشهر الحالي Set foundRow = monthTable.Range("A1:A12").Find(What:=currentMonth, LookIn:=xlValues, LookAt:=xlWhole) If foundRow Is Nothing Then MsgBox "Current sheet name '" & currentMonth & "' not found in MonthNames sheet.", vbCritical GoTo Cleanup End If ' تحديد الشهر التالي If foundRow.Row = 12 Then nextMonth = monthTable.Range("A1").Value nextMonthArabic = monthTable.Range("B1").Value Else nextMonth = monthTable.Cells(foundRow.Row + 1, 1).Value nextMonthArabic = monthTable.Cells(foundRow.Row + 1, 2).Value End If ' التأكد أن الشيت غير موجود مسبقًا For i = 1 To ThisWorkbook.Sheets.Count If ThisWorkbook.Sheets(i).Name = nextMonth Then MsgBox "Sheet '" & nextMonth & "' already exists.", vbExclamation GoTo Cleanup End If Next i ' نسخ الشيت الحالي ws.Copy After:=ws Set copiedSheet = ActiveSheet On Error Resume Next copiedSheet.Name = nextMonth If Err.Number <> 0 Then MsgBox "Error renaming the new sheet.", vbCritical GoTo Cleanup End If On Error GoTo 0 ' تفريغ البيانات copiedSheet.Range("F11:AJ500").ClearContents ' تحديث D5 copiedSheet.Range("D5").Value = nextMonthArabic ' فك الحماية copiedSheet.Unprotect Password:="1234" copiedSheet.Range("F11:AJ130").Locked = False ' قراءة العطلات من الشيت "data" Set holidayRange = dataSheet.Range("F5:F25") ' المرور على الأعمدة من F إلى AJ (أرقام الأعمدة 6 إلى 36) For colNum = 6 To 36 Set dateCell = copiedSheet.Cells(10, colNum) Set col = copiedSheet.Range(copiedSheet.Cells(11, colNum), copiedSheet.Cells(130, colNum)) isHoliday = False If IsDate(dateCell.Value) Then checkDate = CDate(dateCell.Value) ' استخدام Weekday مع vbSaturday: السبت = 1، الجمعة = 7 weekdayNum = Weekday(checkDate, vbSaturday) ' التحقق من العطلات الرسمية For Each holidayCell In holidayRange If IsDate(holidayCell.Value) Then If Int(CDate(holidayCell.Value)) = Int(checkDate) Then isHoliday = True Exit For End If End If Next holidayCell ' إذا الجمعة (7) أو السبت (1) أو عطلة If weekdayNum = 1 Or weekdayNum = 7 Or isHoliday Then ' كتابة النص في الخلايا الفارغة وقفل العمود وحذف القائمة المنسدلة Dim r As Range For Each r In col If Trim(r.Value) = "" Then r.Value = lockedText End If r.Locked = True Next r On Error Resume Next col.Validation.Delete On Error GoTo 0 Else ' السماح بالكتابة في الأيام الأخرى col.Locked = False End If End If Next colNum ' إعادة الحماية copiedSheet.Protect Password:="1234", UserInterfaceOnly:=True ' تفعيل الشيت الجديد copiedSheet.Activate MsgBox "✅ Sheet '" & nextMonth & "' has been created successfully." & vbCrLf & _ "✔ Fridays, Saturdays, and official holidays are now locked, and the text '" & lockedText & "' has been added." & vbCrLf & _ "✔ Dropdown lists have been removed from locked days.", vbInformation Cleanup: ' إعادة الإعدادات لطبيعتها Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Application.DisplayAlerts = True End Sub

تفضل المطلوب ولو اردت استخدام دالة IF لإضافة شروط إضافية، مثل عرض "كيلو" فقط إذا كانت الجرامات صفرًا. هذه المعادلة فى السطر 56 =IF(MOD(SUM(E3:E53);1000)=0;INT(SUM(E3:E53)/1000)+SUM(F3:F53)&" كيلو";INT(SUM(E3:E53)/1000)+SUM(F3:F53)&" كيلو و "&TEXT(MOD(SUM(E3:E53);1000);"0")&" جرام") شغل.xlsx

جرب هذه المعادلة شرح المعادلة ROUND(L4/280*100,1): تقوم هذه الدالة بحساب النسبة المئوية وتقريبها إلى خانة عشرية واحدة. INT(ROUND(L4/280*100,1)): تقوم هذه الدالة بإرجاع الجزء الصحيح من الرقم المقرب. IF(ROUND(L4/280*100,1)=INT(ROUND(L4/280*100,1)),...,...): تقوم هذه الدالة بالتحقق مما إذا كان الرقم المقرب مساويًا للجزء الصحيح منه. إذا كان مساويًا، فهذا يعني أن الرقم صحيح، وإلا فهو عشري. TEXT(ROUND(L4/280*100,1),"0"): إذا كان الرقم صحيحًا، تقوم هذه الدالة بتحويله إلى نص بدون أصفار عشرية. TEXT(ROUND(L4/280*100,1),"0.0"): إذا كان الرقم عشريًا، تقوم هذه الدالة بتحويله إلى نص بخانة عشرية واحدة. مثال إذا كانت L4 تحتوي على 140، فإن الناتج سيكون 50. إذا كانت L4 تحتوي على 141، فإن الناتج سيكون 50.4. آمل أن تكون هذه المعادلة المعدلة تحقق المطلوب. =IF(ROUND(L3/280*100;1)=INT(ROUND(L3/280*100;1));TEXT(ROUND(L3/280*100;1);"0");TEXT(ROUND(L3/280*100;1);"0.0"))

احسنت ا / محمد هشام

وهذا كود معدل لجعل النطاقات في areas تعتمد على LastRow لتكون ديناميكية وتتغير تلقائيًا مع عدد الصفوف في ورقة العمل Private Sub Worksheet_Change(ByVal Target As Range) Dim rng As Range Dim areas As Range Dim lastRow As Long ' تحديد آخر صف يحتوي على بيانات في العمود C (أو أي عمود آخر يحتوي على بيانات) lastRow = Me.Cells(Me.Rows.Count, "C").End(xlUp).Row ' إعداد النطاقات المتعددة باستخدام LastRow Set areas = Union(Me.Range("C10:L" & lastRow), Me.Range("S10:S" & lastRow), Me.Range("V10:V" & lastRow)) ' التعامل مع تغيير الخلايا On Error GoTo ClearApp Application.EnableEvents = False ' منع اللصق إلا كقيم Set rng = Intersect(Target, areas) If Not rng Is Nothing Then Application.Undo ' التراجع عن اللصق الأصلي For Each cell In rng cell.Value = Target.Value ' لصق القيمة فقط Next cell End If ExitHandler: Application.EnableEvents = True Exit Sub ClearApp: Resume ExitHandler End Sub

وهذا الكود الى اخر بيانات مدرجه وليس نطاق معين .Range("A6:AH75").Sort Key1:=.Range("L6:L75"), Order1:=xlDescending, Header:=xlNo .Range("A6:AH75").Sort Key1:=.Range("L6:L75"), Order1:=xlDescending, Header:=xlNo Sub ترتيب_وعرض_أرصدة_العملاء() Dim ws As Worksheet Dim lastRow As Long Dim i As Long Dim totalDebt As Double Set ws = ThisWorkbook.Sheets("ورقة1") With ws ' 1. تحديد LastRow lastRow = .Cells(.Rows.Count, "L").End(xlUp).Row ' 2. ترتيب البيانات تنازليًا حسب رصيد العميل باستخدام LastRow .Range("A6:AH" & lastRow).Sort Key1:=.Range("L6:L" & lastRow), Order1:=xlDescending, Header:=xlNo ' 3. إخفاء الصفوف التي تحتوي على أرصدة غير موجبة أو تساوي صفرًا For i = 6 To lastRow If .Cells(i, "L").Value <= 0 Then .Rows(i).Hidden = True Else .Rows(i).Hidden = False End If Next i ' 4. حساب إجمالي المديونية باستخدام LastRow totalDebt = WorksheetFunction.SumIf(.Range("L6:L" & lastRow), ">0") ' 5. عرض إجمالي المديونية وتنسيقها .Range("AH1").Value = totalDebt .Range("AH1").NumberFormat = "#,##0.00 ""ج.م""" ' تنسيق مخصص ' 6. تنسيق الخلية AI1 With .Range("AI1") .Font.Color = RGB(255, 0, 0) .Font.Bold = True .Value = "إجمالي المديونية: " & totalDebt End With End With End Sub

جرب هذا الكود Private Sub Worksheet_Change(ByVal Target As Range) Dim rng As Range Dim areas As Range Dim cell As Range ' إعداد النطاقات المتعددة Set areas = Union(Me.Range("C10:L109"), Me.Range("S10:S109"), Me.Range("V10:V109")) ' التعامل مع تغيير الخلايا On Error GoTo ClearApp Application.EnableEvents = False ' منع اللصق إلا كقيم Set rng = Intersect(Target, areas) If Not rng Is Nothing Then Application.Undo ' التراجع عن اللصق الأصلي For Each cell In rng cell.Value = Target.Value ' لصق القيمة فقط Next cell End If ExitHandler: Application.EnableEvents = True Exit Sub ClearApp: Resume ExitHandler End Sub

رتيب البيانات: تمت إضافة lastRow = .Cells(.Rows.Count, "L").End(xlUp).Row لتحديد آخر صف يحتوي على بيانات في العمود L (رصيد العميل). هذا يضمن أن الحلقة التالية تغطي جميع البيانات. إخفاء الصفوف: تمت إضافة حلقة For للتكرار على جميع الصفوف من 6 إلى lastRow. داخل الحلقة، يتم التحقق من قيمة رصيد العميل في العمود L. إذا كان الرصيد غير موجب (أقل من أو يساوي صفرًا)، يتم إخفاء الصف باستخدام .Rows(i).Hidden = True. إذا كان الرصيد موجبًا، يتم إظهار الصف باستخدام .Rows(i).Hidden = False (للتأكد من إظهار الصفوف التي قد تكون مخفية سابقًا). حساب إجمالي المديونية: تم استخدام الدالة WorksheetFunction.SumIf لحساب مجموع الأرصدة الموجبة فقط في النطاق L6:L75. تم تخزين النتيجة في المتغير totalDebt. عرض إجمالي المديونية: تمت إضافة السطر .Range("AI1").Value = "إجمالي المديونية: " تمت إضافة السطر . & totalDebt لعرض إجمالي المديونية في الخلية AH1. بللون الاحمر خط عريض وتنسيق القيمة بالجنية المصرى يمكنك تغيير الخلية حسب الحاجة. Sub ترتيب_وعرض_أرصدة_العملاء() Dim ws As Worksheet Dim lastRow As Long Dim i As Long Dim totalDebt As Double Set ws = ThisWorkbook.Sheets("ورقة1") With ws ' 1. ترتيب البيانات تنازليًا حسب رصيد العميل .Range("A6:AH75").Sort Key1:=.Range("L6:L75"), Order1:=xlDescending, Header:=xlNo ' 2. إخفاء الصفوف التي تحتوي على أرصدة غير موجبة أو تساوي صفرًا lastRow = .Cells(.Rows.Count, "L").End(xlUp).Row For i = 6 To lastRow If .Cells(i, "L").Value <= 0 Then .Rows(i).Hidden = True Else .Rows(i).Hidden = False End If Next i ' 3. حساب إجمالي المديونية totalDebt = WorksheetFunction.SumIf(.Range("L6:L75"), ">0") ' 4. عرض إجمالي المديونية .Range("AI1").Value = "إجمالي المديونية: " .Range("AH1").Value = totalDebt .Range("AH1").NumberFormat = "#,##0.00 ""ج.م""" ' تنسيق مخصص ' 5. تنسيق الخلية AH1 With .Range("AH1") .Font.Color = RGB(255, 0, 0) ' تعيين لون الخط إلى الأحمر .Font.Bold = True ' تعيين الخط إلى عريض End With End With End Sub مديونية 2025م(1).xls

ماذالت المشكلة قائمة فى عرض التقارير والخصومات حضور وانصراف 1.xlsm

مشكلة فى عرض تقرير حضور وانصراف بصيغة word/pdf حضور وانصراف 1.xlsm