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

عبد إذن أخونا الفاضل @عبدالله بشير عبدالله بطريقة مختصرة Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$B$6" Then Application.ScreenUpdating = False Dim f As Worksheet, WS As Worksheet, search As String, tmp As Range, Lr As Long, i As Integer Set f = Sheets("السجل") Set WS = Sheets("استدعاء") search = WS.Range("B6").Value If search = "" Then Exit Sub Lr = f.Cells(f.Rows.Count, "B").End(xlUp).Row Set tmp = f.Range("B2:B" & Lr).Find(search, LookIn:=xlValues, LookAt:=xlWhole) If Not tmp Is Nothing Then For i = 0 To 3 WS.Range("A" & 9 + i * 3 & ":I" & 9 + i * 3).Value = _ f.Range(tmp.Offset(0, i * 9 + 1), tmp.Offset(0, (i + 1) * 9)).Value Next i Else MsgBox "الإسم غير موجود في السجل" End If Application.ScreenUpdating = True End If End Sub OR If Not tmp Is Nothing Then For i = 1 To 4 '(i - 1) * 9 لإزاحة النطاق المنسوخ 9 أعمدة في كل مرة '(i - 1) * 3 تحريك الصفوف بمقدار 3 صفوف في كل مرة WS.Range("A" & 9 + (i - 1) * 3 & ":I" & 9 + (i - 1) * 3).Value = _ f.Range(tmp.Offset(0, (i - 1) * 9 + 1), tmp.Offset(0, i * 9)).Value Next i Else

بارك الله فيك أخى موسى ، وأطال الله عمرك ونفع بك تعديلك فى المثال ممتاز للبحث ، والحذف للسجلات المختارة بعد البحث جربته على أكسس 2010 وجدته يعمل بكفاءة لكن عند تجربته على أكسس 2003 وهو الإفتراضى عندى كانت هناك بعض أخطاء التوافق فى المكتبات لكن الغريب عندما أردت إضافة تلك المكتبات وجدت الأمر References باهت ولا يمكن اختياره أما بخصوص كلمة Name لم أجد لها تأثير فى أكسس 2003 .. لكن جاري تغييرها فى أصل التطبيق تحسباً لعدم تسامح البرنامج فى مواضع أخرى لكلماته المحجوزة

جرب هذا التعدل .. التعديل تم على البحث فقط .. لو أردت البحث عن اسم الأب أو الجد بعد اسم الطالب أكتب * بدل المسافة db1 (Moosak).mdb

لقد تم تعديل الاسم من name الى xname لان كلمة name كلمة محجوزة فى الاكسس تم عمل نموذج فرعى حتى يتم البحث بالانزلاق لعل يكون هذا طلبك والله المستعان db1.mdb

نعم يوجد على اعتبار اسم الحقل : text1 حدث النقر على الزر سيكون مثل هذا text1 = Null أو text1 = ""

اخي الكريم انت جديد على المنتدى .. ومن حقك ان تتعجب لماذا لا يتم الرد عليك بينما غيرك يتم الرد عليه؟؟ السبب انك تطلب شيئا مجهولا لا يعرفه الا انت . حتى تحصل على اجابة سريعة وشافية من اخوتك هنا .. يجب ان تهيء لهم ادوات العمل التي تمكنهم من مساعدتك . يجب ان ترفع مرفقا مختصرا يشتمل على جدولك والنموذج والتقرير .. مع توفر بعض البيانات للتجربة بالضبط كما يعد الكادر الطبي المريض لمشرط الجراح

وعليكم السلام ورحمة الله وبركاته الكود Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$B$6" Then Application.ScreenUpdating = False Dim wsSource As Worksheet Dim wsTarget As Worksheet Dim nameToFind As String Dim foundCell As Range Dim data As Variant Set wsSource = ThisWorkbook.Sheets("السجل") Set wsTarget = ThisWorkbook.Sheets("استدعاء") nameToFind = wsTarget.Range("B6").Value Set foundCell = wsSource.Range("B:B").Find(What:=nameToFind, LookIn:=xlValues, LookAt:=xlWhole) If Not foundCell Is Nothing Then data = wsSource.Range(foundCell.Offset(0, 1), foundCell.Offset(0, 10)).Value wsTarget.Range("A9:I9").Value = data data = wsSource.Range(foundCell.Offset(0, 10), foundCell.Offset(0, 19)).Value wsTarget.Range("A12:I12").Value = data data = wsSource.Range(foundCell.Offset(0, 19), foundCell.Offset(0, 28)).Value wsTarget.Range("A15:I15").Value = data data = wsSource.Range(foundCell.Offset(0, 28), foundCell.Offset(0, 38)).Value wsTarget.Range("A18:I18").Value = data Else MsgBox "الاسم غير موجود في السجل." End If Application.ScreenUpdating = True End If End Sub الملف كود استدعاء بيانات1.xlsm

الفكرة بالنسبة للمبيعات هي عند اختيار اسم صفحة المخزون من الخلية C3 سيتم انشاء قائمة منسدلة بأكواد الصنف المتوفرة في نفس الصفحة المختارة تلقائيا لتسهيل عملية البحث وعند اختيار كود الصنف يتم جلب اسم الصنف وبعد ادخال السعر والملاحظات والظغط على زر الترحيل يتم ترحيل بيانات التسجيل الى الصفحة المختارة مع ترحيل نفس البيانات الى ورقة المبيعات في الاعمدة المناسبة و اظافة تاريخ اليوم في العمود الاول من الجدول المشتريات بعد تحديد الصفحة الهدف من الخلية G3 واظافة بيانات التسجيل كود الصنف- اسم الصنف-السعر-الملاحظات يتم ترحيلها الى الصفحة المحددة مع نسخ نفس البيانات المتاحة لجدول المشتريات في الاعمدة المناسبة ادا كانت قد فهمت طلبك بشكل صحيح فهدا سيوفي بالغرض تم دمج اكواد الترحيل لجميع الصفحات في الكود التالي Sub CopyDatasale() Call ProcessTransfer("تسجيل", "المبيعات", Array(1, 2, 7, 8), Array(2, 3, 8, 9), True) End Sub Sub CopyDatabuy() Call ProcessTransfer("تسجيل", "المشتريات", Array(1, 2, 7, 8), Array(1, 2, 7, 8), False) End Sub '======================================= Sub ProcessTransfer(registrationSheetName As String, destName As String, _ stockColumnsArr As Variant, salesColumnsArr As Variant, Cnt As Boolean) Dim WS As Worksheet, f As Worksheet, dest As Worksheet Dim arr As Variant, list As String, MSg As VbMsgBoxResult Dim i As Long Set WS = ThisWorkbook.Sheets(registrationSheetName) Set dest = ThisWorkbook.Sheets(destName) If destName = "المشتريات" Then arr = Array(WS.[G4], WS.[G5], WS.[G6], WS.[G7]) list = WS.[G3].Value Else arr = Array(WS.[C4], WS.[C5], WS.[C6], WS.[C7]) list = WS.[C3].Value End If For i = 0 To 3 If arr(i) = "" Then MsgBox "يرجى إدخال: " & arr(i).Offset(0, -1), vbExclamation, "إنتباه" arr(i).Select Exit Sub End If Next On Error Resume Next Set f = ThisWorkbook.Sheets(list) On Error GoTo 0 If f Is Nothing Then MsgBox "قائمة المخزون " & list & " غير موجودة", vbExclamation Exit Sub End If If MsgBox("ترحيل البيانات؟", vbYesNo + vbQuestion, "تأكــيد") = vbNo Then Exit Sub RegistrationData f, arr, stockColumnsArr RegistrationData dest, arr, salesColumnsArr, Cnt MsgBox list & ": تم ترحيل البيانات بنجاح إلى " & destName & " وقائمة المخزون", vbInformation MSg = MsgBox("هل ترغب في إفراغ بيانات التسجيل؟", vbYesNo + vbQuestion, "تفريغ الخلايا") If MSg = vbYes Then If destName = "المشتريات" Then WS.[G3:G7].ClearContents Else WS.[C3:C7].ClearContents End If End If End Sub '======================================= Sub RegistrationData(sheet As Worksheet, arr As Variant, columnsArr As Variant, Optional Cnt As Boolean = False) Dim tbl As ListObject, lige As Range, TabBD As Range, i As Long Set tbl = sheet.ListObjects(1) Set lige = tbl.ListColumns(2).Range.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious) Set TabBD = IIf(lige Is Nothing, tbl.ListRows(1).Range, lige.Offset(1)) If Cnt Then TabBD.Cells(1, 1).Value = Format(Date, "dd/mmmm") End If For i = LBound(arr) To UBound(arr) TabBD.Cells(1, columnsArr(i)).Value = arr(i).Value Next i End Sub وفي حدث ورقة التسجيل ضع الكود التالي Private Sub Worksheet_Change(ByVal Target As Range) Dim dest As Worksheet, i As Long, lastRow As Long, TabBD As Boolean, Sh As String, itemCode As String, _ dict As Object, CRng As Range, a As Variant, tmp As Variant Dim WS As Worksheet: Set WS = Sheets("تسجيل") On Error GoTo ErrorHandler Sh = Me.Range("C3").Value itemCode = Me.Range("C4").Value TabBD = False If Sh = "" Then Exit Sub Application.ScreenUpdating = False Application.EnableEvents = False Select Case Target.Address Case Me.Range("C3").Address If Not Check(Sh, dest) Then TabBD = True Else lastRow = dest.Cells(dest.Rows.Count, "C").End(xlUp).Row Set CRng = dest.Range("C4:C" & lastRow) tmp = CRng.Value Set dict = CreateObject("Scripting.Dictionary") For i = 1 To UBound(tmp, 1) If tmp(i, 1) <> "" And Not dict.Exists(tmp(i, 1)) Then dict.Add tmp(i, 1), Nothing End If Next i With WS.Range("L3:L" & WS.Cells(WS.Rows.Count, "L").End(xlUp).Row) .ClearContents End With If dict.Count > 0 Then With WS.Range("L3").Resize(dict.Count) .Value = Application.Transpose(dict.Keys) End With End If WS.Range("C4:C5").Value = "" Call Add_listeDéroulante End If Case Me.Range("C4").Address If Sh = "" Or itemCode = "" Then TabBD = True Else If Not Check(Sh, dest) Then TabBD = True Else lastRow = dest.Cells(dest.Rows.Count, "C").End(xlUp).Row Set CRng = dest.Range("C4:C" & lastRow) tmp = CRng.Value a = Application.Match(itemCode, Application.Index(tmp, 0, 1), 0) If Not IsError(a) Then WS.Range("C5").Value = dest.Cells(a + 3, "D").Value Else WS.Range("C5").Value = "" TabBD = True End If End If End If End Select ExitHandler: Application.EnableEvents = True Application.ScreenUpdating = True Exit Sub ErrorHandler: MsgBox "Error : " & Err.Description, vbExclamation TabBD = True Resume ExitHandler End Sub Function Check(sheetName As String, ByRef dict As Worksheet) As Boolean On Error Resume Next Set dict = Sheets(sheetName) On Error GoTo 0 If dict Is Nothing Then MsgBox "غير موجودة" & " " & sheetName & " : " & "الصفحة", vbExclamation Check = False Else Check = True End If End Function مبيعات ومشتريات.xlsb

نعم اخي يمكننا تنفيد دالك بعد تعديل بعض الاجراءات على الملف وتعديل الاكواد بما يتناسب مع طلبك اولا سنقوم بتغيير طريقة تعبئة القوائم المنسدلة تفاديا للاخطاء وحدف الاكواد الموجودة على حدث ThisWorkbook Sub Add_listeDéroulante() Dim OnRng As Range, Data As Range Dim WS As Worksheet: Set WS = Sheets("Sheet1") Dim f As Worksheet: Set f = Sheets("Sheet2") Set OnRng = WS.Range("B15:B24") Set Data = f.Range(f.Range("P4"), f.Range("P" & f.Rows.Count).End(xlUp)) With OnRng.Validation .Delete .Add Type:=xlValidateList, Formula1:="='" & f.Name & "'!" & Data.Address .InCellDropdown = True .ShowError = True End With End Sub في حدث Sheet2 Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Me.Columns("B")) Is Nothing Then Application.ScreenUpdating = False Application.EnableEvents = False Dim tmp As Object Set tmp = CreateObject("Scripting.Dictionary") Dim n As Range For Each n In Range("B4", [B65000].End(xlUp)) If n.Value <> "" Then tmp(n.Value) = "" Next n With Range("P4:P65000") .ClearContents .Resize(tmp.Count) = Application.Transpose(tmp.Keys) End With Application.EnableEvents = True Application.ScreenUpdating = True End If End Sub كود حفظ الفاتورة PDF داخل مجلد في نفس مسار الملف Sub Print_the_invoice() Dim s As Range, cell As Range Dim i As Long, r As Long, arr As Variant Dim Num_Inv As String, Client As String Dim n As String, Cnt As String, xDate As String Dim dossier As String, xPath As String Dim WS As Worksheet: Set WS = Sheets("Sheet1") Set ligne = WS.[B15:E15] xDate = WS.[E13].Value Client = WS.[B11].Value Num_Inv = WS.[E11].Value arr = Array(Client, Num_Inv, xDate) For i = 0 To UBound(arr) If IsEmpty(arr(i)) Or arr(i) = "" Then n = "يرجى ملء بيانات " & Choose(i + 1, "إسم العميل", "رقم الفاتورة", "تاريخ الفاتورة") MsgBox n, vbExclamation, "تنبيه" Exit Sub End If If i = 1 And Not IsNumeric(arr(i)) Then MsgBox "يرجى التحقق من رقم الفاتورة", vbExclamation, "تنبيه" Exit Sub End If Next i For Each cell In ligne If IsEmpty(cell.Value) Then MsgBox "المرجوا التحقق من بيانات الفاتورة", vbExclamation: Exit Sub Next cell Cnt = WS.[D11].Value & " : " & Num_Inv & " " & _ WS.[A11].Value & " : " & Client & " " & vbCrLf & vbCrLf & _ WS.[A25].Value & " : " & Format(WS.[E25].Value, "##,0") & vbCrLf & vbCrLf If MsgBox(Cnt & vbCrLf & "هل تريد طباعة الفاتورة؟", vbYesNo + vbQuestion, "تأكيد طباعة الفاتورة") = vbNo Then Exit Sub End If Application.ScreenUpdating = False dossier = ThisWorkbook.Path & "\Invoices" If Dir(dossier, vbDirectory) = "" Then MkDir dossier End If xPath = dossier & "\" & Client & ".pdf" With WS Rows(15 & ":" & 24).EntireRow.Hidden = False For i = 15 To 24 If Cells(i, "B") = "" Then Rows(i).Hidden = True Next i .PageSetup.PrintArea = "A1:E35" .ExportAsFixedFormat Type:=xlTypePDF, Filename:=xPath Rows(15 & ":" & 24).EntireRow.Hidden = False End With r = CLng(Num_Inv) r = r + 1 WS.[E11].Value = Format(r, "00000") If MsgBox("هل تريد تفريغ بيانات الفاتورة؟", vbYesNo + vbQuestion, "تأكيد تفريغ البيانات") = vbYes Then Union(WS.Range("B11:B13"), WS.Range("E13"), WS.Range("B15:C24")).ClearContents End If Application.ScreenUpdating = True End Sub فاتورة جديدة Sub New_invoice() Dim n As Variant, t As Long, rng As Range Dim WS As Worksheet: Set WS = Sheets("Sheet1") Set rng = WS.[E15:E24] n = WS.[E11].Value If Application.WorksheetFunction.CountA(rng) = 0 Then: Exit Sub Application.ScreenUpdating = False Application.EnableEvents = False If MsgBox("فاتــورة جديدة؟", vbYesNo + vbQuestion, "تأكيد تفريغ البيانات") = vbYes Then Union(WS.Range("B11:B13"), WS.Range("E13"), WS.Range("B15:E24"), WS.Range("E25")).ClearContents If IsNumeric(n) Then t = CLng(n) t = t + 1 WS.[E11].Value = Format(t, "00000") End If End If Application.EnableEvents = True Application.ScreenUpdating = True End Sub فاتورة مبيعات مميزه2.xlsm

إدن هدا سوف يوفي بالغرض Sub Supp_lignes_Returns_formulas() Dim lr&, j&, i&, a, OnRng As Range Dim arr() As Variant, tmp As Variant Dim f As Worksheet: Set f = ActiveSheet lr = f.Columns("C:P").Find(What:="*", _ SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row Set OnRng = f.Range("C7:P" & lr) tmp = OnRng.Value Application.ScreenUpdating = False ReDim arr(1 To UBound(tmp, 1), 1 To UBound(tmp, 2)) a = 1 For i = 1 To UBound(tmp, 1) If tmp(i, 2) <> "" And _ WorksheetFunction.CountA(Application.Index(tmp, i, 0)) > 0 Then For j = 1 To UBound(tmp, 2) arr(a, j) = tmp(i, j) Next j a = a + 1 End If Next i If a > 1 Then f.Range("C7:P" & lr).ClearContents f.Range("C7").Resize(a - 1, UBound(arr, 2)).Value = arr Else f.Range("C7:P" & lr).ClearContents End If Application.ScreenUpdating = True End Sub test002.xlsm

بالنسبة لهده النقطة قد تم تعديلها لدمج بيانات مثلا السابعة و السابعة مهندسين في ورقة واحدة اما بخصوص البحث اظن انك بحاجة لتغيير طريقة البحث لتتمكن من فرز البيانات بجزء من قيمة البحث على جميع الأعمدة انصحك باستخدام نمودج مستخدم (يوزرفورم) سيوفر لك سرعة جلب البيانات خاصة ان ملفك الاصلي يتضمن ما يقارب 10 الف موظف الموظفين 2.xlsb

م. محمد هشام م. عبدالله بشير بارك الله فيكما ونفع بعلمكما وكتب الله لكم الاجر والثواب كل الشكر والاحترام والتقدير على جهودكم ودعمكم اللامحدود

بارك الله فيك اخي @عبدالله بشير عبدالله نعم يمكننا إظافة شروط أخرى بطريقة مختصرة وبدون تقييد للمعايير فقط يكفي الإشارة على عناوين خلايا تنفيد الكود مع تعديل طريقة الفلترة لنتمكن من التحقق من وجود بيانات مطابقة قبل الانتقال لورقة لوحة المعلومات وفلترة البيانات Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim rCrit As String, Lr As Long Dim OneRng As Variant, i As Long, cnt As Boolean Dim f As Worksheet: Set f = Sheets("الرئيسية") If Not Intersect(Target, Me.Range("B17, C17, D17, E17, F17, G17")) Is Nothing Then rCrit = Target.Value If rCrit = "" Then Exit Sub If f.AutoFilterMode Then f.AutoFilterMode = False Lr = f.Cells(f.Rows.count, "J").End(xlUp).Row OneRng = f.Range("J2:J" & Lr).Value For i = 1 To UBound(OneRng, 1) If OneRng(i, 1) = rCrit Then: cnt = True: Exit For Next i If cnt Then f.Activate With f.Range("B2:L" & Lr) .AutoFilter 9, rCrit End With Application.Goto f.Range("J2") Else MsgBox "قاعدة البيانات لا تتضمن معاملات من نوع " & rCrit, vbInformation, "نتيجة الفلترة" End If End If End Sub كما يمكننا كدالك استخدام مصفوفة (Array) لتحديد مجموعة من الخلايا بدلاً من تحديدها بشكل مباشر Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim rCrit As String, Lr As Long, n As Boolean, ColArray As Variant Dim OneRng As Variant, i As Long, cnt As Boolean Dim f As Worksheet: Set f = Sheets("الرئيسية") ColArray = Array("B17", "C17", "D17", "E17", "F17", "G17") For i = LBound(ColArray) To UBound(ColArray) If Not Intersect(Target, Me.Range(ColArray(i))) Is Nothing Then n = True Exit For End If Next i If n Then rCrit = Target.Value If rCrit = "" Then Exit Sub If f.AutoFilterMode Then f.AutoFilterMode = False Lr = f.Cells(f.Rows.count, "J").End(xlUp).Row OneRng = f.Range("J2:J" & Lr).Value For i = 1 To UBound(OneRng, 1) If OneRng(i, 1) = rCrit Then: cnt = True: Exit For Next i If cnt Then f.Activate With f.Range("B2:L" & Lr) .AutoFilter 9, rCrit End With Application.Goto f.Range("J2") Else MsgBox "قاعدة البيانات لا تتضمن معاملات من نوع " & rCrit, vbInformation, "نتيجة الفلترة" End If End If End Sub ملف ادارة طلبات.xlsb

وعليكم السلام ورحمة الله تعالى وبركاته بعد اذن استاذنا الفاضل محمد هشام ,حل لكل الخيارات وان لم يطلبها صاحب الموضوع الكود Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim wsDashboard As Worksheet Dim wsMain As Worksheet Dim rng As Range Dim count As Long Dim filterValue As String Set wsDashboard = ThisWorkbook.Sheets("لوحة المعلومات") Set wsMain = ThisWorkbook.Sheets("الرئيسية") Select Case Target.Address Case wsDashboard.Range("C17").Address filterValue = "تحت الاجراء" Case wsDashboard.Range("D17").Address filterValue = "في الانتظار" Case wsDashboard.Range("F17").Address filterValue = "مكتمل" Case wsDashboard.Range("G17").Address filterValue = "محالة" Case wsDashboard.Range("H17").Address filterValue = "معلق / مؤجل" Case Else Exit Sub End Select wsMain.Activate If wsMain.AutoFilterMode Then wsMain.AutoFilterMode = False End If wsMain.Range("A1").AutoFilter Field:=10, Criteria1:=filterValue Set rng = wsMain.Range("J2:J" & wsMain.Cells(wsMain.Rows.count, "J").End(xlUp).Row) count = Application.WorksheetFunction.CountIf(rng, filterValue) If count > 0 Then MsgBox "عدد الطلبات التي تحتوي على '" & filterValue & "' هو: " & count Else MsgBox "لا توجد طلبات تحتوي على '" & filterValue & "'." End If End Sub الملف ملف ادارة طلبات1.xlsb

وعليكم السلام ورحمة الله وبركاته السؤال واضح ولكن وضع فكرة السؤال في كود تحتاج الى وقت لجعل العمل بالملف بطريقة مبسطة وليست معقدة المهم فكرة الكود الحالية بدون اي InputBox ملفك به عدة صفحات كل صفحة بمرتبة معينة اذا اردت تغيير المراتب فمثلا في صفحة مرتبة 6 قم بتغييرعدد من الموظفين الى مراتب جديدة متساوية او مختلفة ثم اذهب الى صفحة مرتبة9 مثلا وقم بتغيير مراتب موظفين الى مراتب اعلى او اقل عند الضغظ على الزر يتم حذف من تغييرت مراتبهم من صفحاتهم وترحليهم كل الى صفحته والكود يرحل من مرتبة اقل الى اعلى او العكس بالمختصر خطوتان الاولى امام اي موظف غير المرتبة المطلوبة لاي عدد تشاءوفي اي صفحة الثانية الضغظ على الزر الكود Sub TransferEmployeeData() Dim ws As Worksheet Dim targetWs As Worksheet Dim lastRow As Long Dim i As Long Dim rank As String Dim targetRank As String Dim targetRow As Long Dim data As Variant Dim targetData As Variant Dim targetLastRow As Long Application.ScreenUpdating = False Application.Calculation = xlCalculationManual For Each ws In ThisWorkbook.Worksheets If Left(ws.Name, 7) = "المرتبة" Then lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row For i = lastRow To 2 Step -1 rank = ws.Cells(i, 4).Value If rank <> Mid(ws.Name, 9) Then On Error Resume Next Set targetWs = ThisWorkbook.Worksheets("المرتبة " & rank) On Error GoTo 0 If Not targetWs Is Nothing Then targetLastRow = targetWs.Cells(targetWs.Rows.Count, "A").End(xlUp).Row + 1 targetWs.Rows(targetLastRow).Value = ws.Rows(i).Value ws.Rows(i).Delete End If End If Next i End If Next ws Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic End Sub الملف ترحيل موظف1 (1).xlsb

تفضل أخي الكريم تم استعمال نفس فكرة اليومي والخصم في نفس يوم تاريخ البداية مع اختلاف الشهور بالتوفيق خصم يومي أو شهري تلقائي .xlsx

Help me please