عنوان مساعدة فى عمل برنامج محاسبى متطور

[mahmoud nasr alhasany]

من يساعدنى فى عمل برنامج محاسبى بيع شراء تحويل

الدليل المختصر هو ما يضمن استمرارية العمل وحماية النظام من سوء الاستخدام. إليك دليل المستخدم الموحد المصمم ليوضع في شيت باسم "التعليمات" أو يطبع للموظفين:

📘 دليل مستخدم برنامج إدارة المخازن الاحترافي

1️⃣ تسجيل حركة جديدة (إضافة / تحويلات / بيع / شراء)

افتح لوحة التحكم واضغط على زر "إضافة حركة".

سيقوم البرنامج بإنشاء رقم إذن تلقائي وتاريخ اليوم.

اختر نوع الحركة؛ سيقوم النظام بتكييف الخيارات بناءً على اختيارك.

اختر المخزن ثم الصنف. سيظهر لك "الرصيد المتاح" فوراً أسفل الصنف.

أدخل الكمية؛ إذا تجاوزت الرصيد المتاح في عمليات الصرف، سيتحول لون الخانة للأحمر ويمنعك النظام من الحفظ.

اضغط حفظ؛ سيتم ترحيل البيانات وتحديث التقارير فوراً.

2️⃣ عملية التحويل بين المخازن

عند اختيار نوع الحركة "تحويل"، سيظهر لك تلقائياً خانة "المخزن المحول إليه".

تأكد من اختيار مخزن المصدر (من) ومخزن الهدف (إلى).

سيقوم البرنامج بخصم الكمية من الأول وإضافتها للثاني في خطوة واحدة.

3️⃣ التراجع عن العمليات (التصحيح)

من داخل اليوزرفورم، انتقل إلى قائمة "التراجع عن الحركات".

ستظهر لك قائمة بآخر 10 تحويلات تمت.

حدد الحركة التي تريد إلغاءها من القائمة واضغط "تراجع عن الحركة".

تنبيه: أي عملية تراجع يتم تسجيلها سرياً في "سجل المراقبة" باسم المستخدم ووقت الحذف.

4️⃣ إدارة تواريخ الصلاحية وحد الطلب

عند إدخال صنف جديد، تأكد من إدخال تاريخ الصلاحية.

عند فتح الملف، سيعطيك البرنامج تنبيهاً تلقائياً بالأصناف التي ستنتهي خلال 3 أشهر.

إذا قل رصيد صنف عن "حد الطلب" المعرف في الإعدادات، سيظهر لك تنبيه بضرورة إعادة الشراء.

5️⃣ استخراج التقارير

جرد المخازن: يعطيك الأرصدة الحالية مقسمة (كرتونة / قطعة).

كرت الصنف: لمتابعة حركة صنف معين في فترة زمنية محددة.

تصدير التقرير: يمكنك تصدير تقارير الصلاحية والنواقص بضغطة زر إلى PDF للإرسال أو Word للتعديل.

⚠️ تعليمات هامة للمدير:

تحديث البيانات: لإضافة صنف جديد أو مخزن جديد، اذهب لشيت Setup وأضفه في القائمة.

كلمة المرور: لا تشارك كلمة مرور محرر VBA مع الموظفين لضمان عدم عبثهم بالأكواد.

الأمان: شيت Audit_Log مخفي تماماً؛ يمكنك الإطلاع عليه من خلال محرر الأكواد فقط لمراقبة عمليات الحذف.

هل اكتملت الصورة لديك الآن؟ 

تم تعديل منذ 1 ساعه بواسطه mahmoud nasr alhasany

[mahmoud nasr alhasany]

1. تصميم نموذج الإدخال (UserForm)

قم بإنشاء UserForm جديد في محرر VBA (Alt + F11) وقم بتسمية العناصر كالتالي:

ComboBox1: لنوع الحركة (إضافة، صرف، تحويل، شراء، بيع).

ComboBox2: للمخزن (المصدر/الرئيسي).

ComboBox3: للمخزن (الهدف - يظهر فقط في حالة التحويل).

ComboBox4: للصنف.

ComboBox5: للوحدة.

ComboBox6: للحالة (جديد، مستعمل، تالف).

TextBox1: للكمية.

Listbox1 : عرض البيانات

CommandButton1: زر "ترحيل

CommandButton2: زر "حفظ

Private Sub UserForm_Initialize()
    Dim wsSetup As Worksheet
    Set wsSetup = Sheets("Setup")
    Dim lastRow As Long
    
    ' 1. تعبئة أنواع الحركة يدوياً
    ComboBox1.List = Array("إضافة", "صرف", "تحويل", "شراء", "بيع")
    
    ' 2. تعبئة المخازن من شيت Setup (العمود A)
    lastRow = wsSetup.Cells(wsSetup.Rows.Count, 1).End(xlUp).Row
    ComboBox2.List = wsSetup.Range("A2:A" & lastRow).Value ' من مخزن
    ComboBox3.List = wsSetup.Range("A2:A" & lastRow).Value ' إلى مخزن
    
    ' 3. تعبئة الأصناف من شيت Setup (العمود B)
    lastRow = wsSetup.Cells(wsSetup.Rows.Count, 2).End(xlUp).Row
    ComboBox4.List = wsSetup.Range("B2:B" & lastRow).Value
    
    ' 4. تعبئة الوحدات والحالات بنفس الطريقة
    ComboBox5.List = Array("قطعة", "كيلو", "كرتونة")
    ComboBox6.List = Array("جديد", "مستعمل", "تالف")
    
    ' تحديث ListBox لعرض آخر الحركات
    UpdateListBox
End Sub
الحركة".
Private Sub ComboBox1_Change()
    ' إذا كانت الحركة تحويل، أظهر خانة المخزن المحول إليه
    If ComboBox1.Value = "تحويل" Then
        ComboBox3.Visible = True
        Label_ToStore.Visible = True ' افترضنا أنك وضعت عنواناً بجانبه
    Else
        ComboBox3.Visible = False
        Label_ToStore.Visible = False
        ComboBox3.Value = "" ' مسح القيمة إذا لم تكن تحويلاً
    End If
End Sub
Sub UpdateListBox()
    Dim ws As Worksheet
    Set ws = Sheets("Transactions")
    Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    
    ' ضبط عدد الأعمدة في ListBox
    With ListBox1
        .ColumnCount = 5
        .ColumnWidths = "60;60;80;80;50"
        
        ' عرض آخر 5 صفوف فقط (إذا توفرت)
        If lastRow > 5 Then
            .List = ws.Range("A" & lastRow - 4 & ":E" & lastRow).Value
        ElseIf lastRow > 1 Then
            .List = ws.Range("A2:E" & lastRow).Value
        End If
    End With
End Sub
Private Sub BtnSearch_Click()
    Dim ws As Worksheet: Set ws = Sheets("Transactions")
    Dim rowNum As Long
    Dim searchText As String
    
    searchText = TxtSearch.Value ' خانة البحث عن رقم الإذن
    
    On Error Resume Next
    ' البحث عن رقم الإذن في العمود الثاني (رقم الإذن)
    rowNum = Application.Match(CLng(searchText), ws.Columns(2), 0)
    On Error GoTo 0
    
    If rowNum > 0 Then
        ' تعبئة الخانات بالبيانات الموجودة في الشيت
        ComboBox1.Value = ws.Cells(rowNum, 2).Value ' نوع الحركة
        ComboBox2.Value = ws.Cells(rowNum, 3).Value ' من مخزن
        ' ... استكمل لبقية الخانات ...
        TextBox1.Value = ws.Cells(rowNum, 8).Value ' الكمية
        
        ' تخزين رقم الصف في Label مخفي للرجوع إليه عند التعديل
        LblRowNumber.Caption = rowNum 
        MsgBox "تم جلب البيانات، يمكنك تعديلها الآن", vbInformation
    Else
        MsgBox "رقم الإذن غير موجود", vbExclamation
    End If
End Sub
Private Sub BtnUpdate_Click()
    Dim ws As Worksheet: Set ws = Sheets("Transactions")
    Dim rowNum As Long
    
    rowNum = Val(LblRowNumber.Caption) ' استرجاع رقم الصف المخزن
    
    If rowNum > 1 Then
        ws.Cells(rowNum, 2).Value = ComboBox1.Value
        ws.Cells(rowNum, 3).Value = ComboBox2.Value
        ws.Cells(rowNum, 5).Value = ComboBox4.Value
        ws.Cells(rowNum, 8).Value = CDbl(TextBox1.Value)
        
        MsgBox "تم تحديث البيانات بنجاح", vbInformation
        UpdateListBox ' تحديث القائمة لرؤية التعديل
    End If
End Sub
Function GetNextSerial() As Long
    Dim ws As Worksheet: Set ws = Sheets("Transactions")
    Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.Count, 2).End(xlUp).Row
    
    If lastRow < 2 Then
        GetNextSerial = 1001 ' يبدأ الترقيم من هذا الرقم
    Else
        GetNextSerial = ws.Cells(lastRow, 2).Value + 1
    End If
End Function
Function ConvertToBox(ItemName As String, TotalPieces As Double) As String
    Dim wsSetup As Worksheet: Set wsSetup = Sheets("Setup")
    Dim PackSize As Integer
    Dim Boxes As Integer, Remainder As Integer
    Dim cell As Range
    
    ' البحث عن سعة كرتونة الصنف في شيت Setup
    Set cell = wsSetup.Range("B:B").Find(ItemName, LookIn:=xlValues, LookAt:=xlWhole)
    
    If Not cell Is Nothing Then
        PackSize = cell.Offset(0, 1).Value ' السعة موجودة في العمود التالي
        
        If PackSize > 0 Then
            Boxes = Int(TotalPieces / PackSize) ' عدد الكراتين الكاملة
            Remainder = TotalPieces Mod PackSize ' القطع المتبقية
            
            ConvertToBox = Boxes & " كرتونة و " & Remainder & " قطعة"
        Else
            ConvertToBox = TotalPieces & " قطعة"
        End If
    Else
        ConvertToBox = TotalPieces & " قطعة"
    End If
End Function
Private Sub TxtQty_Change()
    On Error Resume Next
    If TxtQty.Value <> "" And ComboBox4.Value <> "" Then
        ' تحديث العنوان بالتحويل التلقائي
        LblPackingInfo.Caption = ConvertToBox(ComboBox4.Value, CDbl(TxtQty.Value))
    Else
        LblPackingInfo.Caption = ""
    End If
End Sub
Sub RefreshInventoryReport()
    Dim wsTrans As Worksheet: Set wsTrans = Sheets("Transactions")
    Dim wsInv As Worksheet: Set wsInv = Sheets("Inventory_Summary")
    Dim lastRow As Long, i As Long
    
    ' مسح البيانات القديمة
    wsInv.Range("A2:E1000").ClearContents
    
    ' استخدام Pivot Table خلفي أو مجموع شرطي لجلب الأرصدة
    ' هنا سنفترض أنك تريد جلب الأصناف الفريدة المتاحة
    ' كود مبسط لجلب الأرصدة:
    lastRow = wsTrans.Cells(wsTrans.Rows.Count, 5).End(xlUp).Row
    
    ' كود افتراضي لجمع الكميات (يفضل استخدام PivotTable لسرعة أكبر في البيانات الضخمة)
    ' ولكن هنا سنستخدم الدالة التي برمجناها سابقاً للتحويل
    
    ' مثال لتعبئة الصف الأول (كمثال توضيحي):
    Dim totalQty As Double: totalQty = 150 ' هذا الرقم يأتي من SUMIFS
    Dim itemName As String: itemName = "صنف A"
    
    wsInv.Range("A2").Value = itemName
    wsInv.Range("D2").Value = totalQty
    ' استخدام الدالة التي صممناها في الخطوة السابقة
    wsInv.Range("E2").Value = ConvertToBox(itemName, totalQty)
End Sub
Private Sub ComboBox4_Change()
    Dim ws As Worksheet: Set ws = Sheets("Transactions")
    Dim CurrentStock As Double
    Dim ItemName As String: ItemName = ComboBox4.Value
    Dim StoreName As String: StoreName = ComboBox2.Value ' المخزن المختار
    
    ' حساب الرصيد الحالي برمجياً باستخدام WorksheetFunction
    CurrentStock = Application.WorksheetFunction.SumIfs(ws.Range("I:I"), ws.Range("F:F"), ItemName, ws.Range("D:D"), StoreName) - _
                   Application.WorksheetFunction.SumIfs(ws.Range("I:I"), ws.Range("F:F"), ItemName, ws.Range("C:C"), StoreName)
    
    ' عرض النتيجة للمستخدم مع التحويل للكراتين
    LblCurrentBalance.Caption = "الرصيد المتاح في هذا المخزن: " & ConvertToBox(ItemName, CurrentStock)
End Sub
Private Sub BtnSave_Click()
    Dim ws As Worksheet: Set ws = Sheets("Transactions")
    Dim CurrentStock As Double
    Dim ItemName As String: ItemName = ComboBox4.Value
    Dim StoreName As String: StoreName = ComboBox2.Value
    Dim RequestedQty As Double: RequestedQty = CDbl(TxtQty.Value)
    ' فحص إذا كانت الحركة (صرف، بيع، أو تحويل صادر)
    If ComboBox1.Value = "صرف" Or ComboBox1.Value = "بيع" Or ComboBox1.Value = "تحويل" Then
        
        ' حساب الرصيد الحالي في هذا المخزن تحديداً
        CurrentStock = Application.WorksheetFunction.SumIfs(ws.Range("I:I"), ws.Range("F:F"), ItemName, ws.Range("D:D"), StoreName) - _
                       Application.WorksheetFunction.SumIfs(ws.Range("I:I"), ws.Range("F:F"), ItemName, ws.Range("C:C"), StoreName)
        
        ' المقارنة بين المتاح والمطلوب
        If RequestedQty > CurrentStock Then
            MsgBox "عذراً.. الرصيد غير كافٍ في " & StoreName & vbCrLf & _
                   "الرصيد المتاح هو: " & CurrentStock & " قطعة فقط.", vbCritical, "تنبيه أمان المخزن"
            Exit Sub ' إيقاف عملية الحفظ
        End If
    End If
    ' ... بقية كود الترحيل والحفظ الذي كتبناه سابقاً ...
End Sub
Private Sub TxtQty_Change()
    ' كود إضافي لتحسين تجربة المستخدم
    On Error Resume Next
    ' (بافتراض أنك حسبت CurrentStock مسبقاً)
    If CDbl(TxtQty.Value) > CurrentStock Then
        TxtQty.BackColor = vbRed
        TxtQty.ForeColor = vbWhite
    Else
        TxtQty.BackColor = vbWhite
        TxtQty.ForeColor = vbBlack
    End If
End Sub
Private Sub Workbook_Open()
    Dim wsSetup As Worksheet: Set wsSetup = Sheets("Setup")
    Dim wsTrans As Worksheet: Set wsTrans = Sheets("Transactions")
    Dim lastRow As Long, i As Long
    Dim currentBal As Double, reorderLevel As Double
    Dim itemName As String, msg As String
    
    lastRow = wsSetup.Cells(wsSetup.Rows.Count, 1).End(xlUp).Row
    msg = "الأصناف التالية وصلت لحد الطلب أو أقل:" & vbCrLf
    
    For i = 2 To lastRow
        itemName = wsSetup.Cells(i, 2).Value
        reorderLevel = wsSetup.Cells(i, 4).Value
        
        ' حساب الرصيد الإجمالي للصنف في كل المخازن
        currentBal = Application.WorksheetFunction.SumIfs(wsTrans.Range("I:I"), wsTrans.Range("F:F"), itemName) - _
                     Application.WorksheetFunction.SumIfs(wsTrans.Range("I:I"), wsTrans.Range("F:F"), itemName) ' (تعديل بسيط حسب هيكلة مخازنك)
        
        If currentBal <= reorderLevel Then
            msg = msg & "- " & itemName & " (الرصيد الحالي: " & currentBal & ")" & vbCrLf
        End If
    Next i
    
    If msg <> "الأصناف التالية وصلت لحد الطلب أو أقل:" & vbCrLf Then
        MsgBox msg, vbExclamation, "تنبيه نقص المخزون"
    End If
End Sub
' يوضع هذا الكود بعد ترحيل حركة الصرف مباشرة في زر الحفظ
If (CurrentStock - RequestedQty) <= reorderLevel Then
    MsgBox "تنبيه: الصنف " & ItemName & " أصبح رصيده منخفضاً جداً!", vbInformation
End If
Private Sub BtnSave_Click()
    Dim wsTrans As Worksheet: Set wsTrans = Sheets("Transactions")
    Dim wsSetup As Worksheet: Set wsSetup = Sheets("Setup")
    Dim nextRow As Long, CurrentStock As Double, ReorderLevel As Double
    
    ' --- 1. التحقق من الرصيد (أمان المخزن) ---
    If ComboBox1.Value = "صرف" Or ComboBox1.Value = "بيع" Or ComboBox1.Value = "تحويل" Then
        CurrentStock = Application.WorksheetFunction.SumIfs(wsTrans.Range("I:I"), wsTrans.Range("F:F"), ComboBox4.Value, wsTrans.Range("D:D"), ComboBox2.Value) - _
                       Application.WorksheetFunction.SumIfs(wsTrans.Range("I:I"), wsTrans.Range("F:F"), ComboBox4.Value, wsTrans.Range("C:C"), ComboBox2.Value)
        
        If CDbl(TxtQty.Value) > CurrentStock Then
            MsgBox "عذراً! الرصيد غير كافٍ. المتاح: " & CurrentStock, vbCritical: Exit Sub
        End If
    End If
    ' --- 2. ترحيل البيانات ---
    nextRow = wsTrans.Cells(wsTrans.Rows.Count, 1).End(xlUp).Row + 1
    With wsTrans
        .Cells(nextRow, 1).Value = Date
        .Cells(nextRow, 2).Value = TxtSerial.Value
        .Cells(nextRow, 3).Value = ComboBox1.Value ' نوع الحركة
        .Cells(nextRow, 4).Value = ComboBox2.Value ' من مخزن
        .Cells(nextRow, 5).Value = ComboBox3.Value ' إلى مخزن
        .Cells(nextRow, 6).Value = ComboBox4.Value ' الصنف
        .Cells(nextRow, 8).Value = ComboBox6.Value ' الحالة
        .Cells(nextRow, 9).Value = CDbl(TxtQty.Value)
    End With
    ' --- 3. تنبيه حد الطلب بعد العملية ---
    ' (كود إضافي لفحص حد الطلب من شيت Setup)
    MsgBox "تمت العملية بنجاح!", vbInformation
    Unload Me: UserForm1.Show
End Sub
Private Sub Workbook_Open()
    ' هنا نضع الكود الذي يمسح الأصناف ويقارن أرصدتها بحد الطلب
    ' ويظهر رسالة تحذيرية إذا كان (الرصيد <= حد الطلب)
    Call CheckReorderLevels
End Sub
Sub CheckExpiryDates()
    Dim wsTrans As Worksheet: Set wsTrans = Sheets("Transactions")
    Dim lastRow As Long, i As Long
    Dim expiryDate As Date
    Dim msg As String
    Dim monthsLimit As Integer: monthsLimit = 3
    
    lastRow = wsTrans.Cells(wsTrans.Rows.Count, 1).End(xlUp).Row
    msg = "تنبيه: الأصناف التالية ستنتهي صلاحيتها خلال 3 أشهر:" & vbCrLf
    
    For i = 2 To lastRow
        ' التحقق من وجود تاريخ صلاحية في العمود J
        If IsDate(wsTrans.Cells(i, 10).Value) Then
            expiryDate = wsTrans.Cells(i, 10).Value
            
            ' حساب الفرق بين تاريخ اليوم وتاريخ الصلاحية
            ' DateDiff("m", ...) يحسب الفرق بالشهور
            If DateDiff("m", Date, expiryDate) <= monthsLimit And expiryDate >= Date Then
                msg = msg & "- " & wsTrans.Cells(i, 6).Value & " (تنتهي في: " & expiryDate & ")" & vbCrLf
            End If
        End If
    Next i
    
    If msg <> "تنبيه: الأصناف التالية ستنتهي صلاحيتها خلال 3 أشهر:" & vbCrLf Then
        MsgBox msg, vbExclamation, "مراقبة الصلاحية"
    End If
End Sub
Private Sub TxtExpiry_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    If TxtExpiry.Value <> "" Then
        If Not IsDate(TxtExpiry.Value) Then
            MsgBox "يرجى إدخال التاريخ بصيغة صحيحة (DD/MM/YYYY)", vbCritical
            Cancel = True
        End If
    End If
End Sub
Sub ExportExpiryReportToPDF()
    Dim wsTrans As Worksheet: Set wsTrans = Sheets("Transactions")
    Dim wsTemp As Worksheet
    Dim lastRow As Long, i As Long, targetRow As Long
    Dim fileName As String
    
    ' إنشاء شيت مؤقت للتقرير
    Set wsTemp = Worksheets.Add
    wsTemp.Name = "Expiry_Report_Temp"
    
    ' وضع العناوين
    wsTemp.Range("A1:D1").Value = Array("الصنف", "المخزن", "الكمية", "تاريخ الصلاحية")
    wsTemp.Range("A1:D1").Font.Bold = True
    targetRow = 2
    
    lastRow = wsTrans.Cells(wsTrans.Rows.Count, 1).End(xlUp).Row
    
    ' فلترة الأصناف التي ستنتهي خلال 90 يوم
    For i = 2 To lastRow
        If IsDate(wsTrans.Cells(i, 10).Value) Then
            If wsTrans.Cells(i, 10).Value - Date <= 90 And wsTrans.Cells(i, 10).Value >= Date Then
                wsTemp.Cells(targetRow, 1).Value = wsTrans.Cells(i, 6).Value ' الصنف
                wsTemp.Cells(targetRow, 2).Value = wsTrans.Cells(i, 4).Value ' المخزن
                wsTemp.Cells(targetRow, 3).Value = wsTrans.Cells(i, 9).Value ' الكمية
                wsTemp.Cells(targetRow, 4).Value = wsTrans.Cells(i, 10).Value ' الصلاحية
                targetRow = targetRow + 1
            End If
        End If
    Next i
    
    ' تنسيق الجدول
    wsTemp.Columns("A:D").AutoFit
    
    ' مسار الحفظ (سطح المكتب)
    fileName = Environ("USERPROFILE") & "\Desktop\تقرير_الصلاحية_" & Format(Date, "yyyy-mm-dd") & ".pdf"
    
    ' تصدير إلى PDF
    wsTemp.ExportAsFixedFormat Type:=xlTypePDF, Filename:=fileName
    
    ' حذف الشيت المؤقت
    Application.DisplayAlerts = False
    wsTemp.Delete
    Application.DisplayAlerts = True
    
    MsgBox "تم تصدير تقرير PDF بنجاح إلى سطح المكتب باسم: " & vbCrLf & fileName, vbInformation
End Sub
Sub ExportExpiryToWord()
    Dim wsTrans As Worksheet: Set wsTrans = Sheets("Transactions")
    Dim objWord As Word.Application
    Dim objDoc As Word.Document
    Dim objTable As Word.Table
    Dim i As Long, lastRow As Long, targetRow As Long
    
    ' إنشاء تطبيق Word جديد
    Set objWord = New Word.Application
    objWord.Visible = True ' جعل الوورد مرئياً
    Set objDoc = objWord.Documents.Add
    
    ' إضافة عنوان للمستند
    With objWord.Selection
        .Font.Size = 18
        .Font.Bold = True
        .ParagraphFormat.Alignment = wdAlignParagraphCenter
        .TypeText "تقرير الأصناف التي تقترب صلاحيتها من الانتهاء"
        .TypeParagraph
        .Font.Size = 12
        .Font.Bold = False
        .ParagraphFormat.Alignment = wdAlignParagraphRight
        .TypeText "تاريخ التقرير: " & Date
        .TypeParagraph: .TypeParagraph
    End With
    ' حساب عدد الصفوف التي تنطبق عليها الشروط أولاً لتحديد حجم الجدول
    lastRow = wsTrans.Cells(wsTrans.Rows.Count, 1).End(xlUp).Row
    targetRow = 1
    
    ' إضافة جدول (بشكل مبدئي بصف واحد للعناوين)
    Set objTable = objDoc.Tables.Add(objWord.Selection.Range, 1, 4)
    objTable.Borders.Enable = True
    objTable.Cell(1, 1).Range.Text = "الصنف"
    objTable.Cell(1, 2).Range.Text = "المخزن"
    objTable.Cell(1, 3).Range.Text = "الكمية"
    objTable.Cell(1, 4).Range.Text = "تاريخ الصلاحية"
    objTable.Rows(1).Range.Font.Bold = True
    objTable.Rows(1).Shading.BackgroundPatternColor = wdColorGray10
    ' ملء الجدول بالبيانات المفلترة
    For i = 2 To lastRow
        ' فحص الصلاحية (أقل من 90 يوم)
        If IsDate(wsTrans.Cells(i, 10).Value) Then
            If wsTrans.Cells(i, 10).Value - Date <= 90 And wsTrans.Cells(i, 10).Value >= Date Then
                objTable.Rows.Add
                targetRow = objTable.Rows.Count
                objTable.Cell(targetRow, 1).Range.Text = wsTrans.Cells(i, 6).Value
                objTable.Cell(targetRow, 2).Range.Text = wsTrans.Cells(i, 4).Value
                objTable.Cell(targetRow, 3).Range.Text = wsTrans.Cells(i, 9).Value
                objTable.Cell(targetRow, 4).Range.Text = wsTrans.Cells(i, 10).Value
            End If
        End If
    Next i
    ' رسالة تأكيد
    MsgBox "تم إنشاء مستند Word وتصدير البيانات بنجاح!", vbInformation
End Sub
Sub UndoTransfer()
    Dim wsTrans As Worksheet: Set wsTrans = Sheets("Transactions")
    Dim transID As Variant
    Dim foundRow As Variant
    Dim confirm As VbMsgBoxResult
    
    ' طلب رقم الإذن المراد التراجع عنه
    transID = InputBox("يرجى إدخال رقم الإذن (التحويل) المراد التراجع عنه:", "تراجع عن عملية")
    
    If transID = "" Then Exit Sub ' إلغاء في حال لم يتم إدخال رقم
    
    ' البحث عن رقم الإذن في العمود الثاني
    foundRow = Application.Match(CLng(transID), wsTrans.Columns(2), 0)
    
    If IsError(foundRow) Then
        MsgBox "عذراً، رقم الإذن غير موجود!", vbCritical
        Exit Sub
    End If
    
    ' التأكد أن العملية هي "تحويل"
    If wsTrans.Cells(foundRow, 3).Value <> "تحويل" Then
        MsgBox "هذا الإذن ليس عملية تحويل، لا يمكن التراجع عنه بهذا الزر!", vbExclamation
        Exit Sub
    End If
    
    ' تأكيد الحذف
    confirm = MsgBox("هل أنت متأكد من التراجع عن هذا التحويل؟" & vbCrLf & _
                     "سيتم حذف السجل وإعادة الكمية للمخزن المصدر.", vbQuestion + vbYesNo, "تأكيد")
                     
    If confirm = vbYes Then
        wsTrans.Rows(foundRow).Delete
        MsgBox "تم التراجع عن العملية بنجاح وتحديث المخزون.", vbInformation
        ' تحديث أي قوائم أو تقارير مفتوحة
        Call UpdateListBox
    End If
End Sub
Sub UndoTransferWithAudit()
    Dim wsTrans As Worksheet: Set wsTrans = Sheets("Transactions")
    Dim wsAudit As Worksheet: Set wsAudit = Sheets("Audit_Log")
    Dim transID As Variant
    Dim foundRow As Variant
    Dim nextAuditRow As Long
    
    transID = InputBox("أدخل رقم الإذن للتراجع عنه:", "نظام الرقابة")
    If transID = "" Then Exit Sub
    
    ' البحث عن السجل
    foundRow = Application.Match(CLng(transID), wsTrans.Columns(2), 0)
    
    If Not IsError(foundRow) Then
        ' 1. تسجيل البيانات في سجل المراقبة قبل الحذف
        nextAuditRow = wsAudit.Cells(wsAudit.Rows.Count, 1).End(xlUp).Row + 1
        
        With wsAudit
            .Cells(nextAuditRow, 1).Value = Now ' التاريخ والوقت الحالي
            .Cells(nextAuditRow, 2).Value = wsTrans.Cells(foundRow, 2).Value ' رقم الإذن
            .Cells(nextAuditRow, 3).Value = wsTrans.Cells(foundRow, 6).Value ' الصنف
            .Cells(nextAuditRow, 4).Value = wsTrans.Cells(foundRow, 9).Value ' الكمية
            .Cells(nextAuditRow, 5).Value = wsTrans.Cells(foundRow, 4).Value ' المخزن المصدر
            .Cells(nextAuditRow, 6).Value = Application.UserName ' اسم مستخدم الكمبيوتر
            .Cells(nextAuditRow, 7).Value = "تراجع/حذف تحويل"
        End With
        
        ' 2. تنفيذ الحذف الفعلي
        wsTrans.Rows(foundRow).Delete
        MsgBox "تم التراجع وتسجيل العملية في سجل الرقابة.", vbInformation
    Else
        MsgBox "رقم الإذن غير موجود!", vbCritical
    End If
End Sub
Sub FillUndoList()
    Dim ws As Worksheet: Set ws = Sheets("Transactions")
    Dim lastRow As Long, i As Long
    
    ListBox2.Clear
    ListBox2.ColumnCount = 4
    ListBox2.ColumnWidths = "50;80;80;50" ' رقم الإذن، الصنف، من، إلى
    
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    
    ' عرض آخر 10 حركات تحويل فقط لسهولة التراجع
    For i = lastRow To 2 Step -1
        If ws.Cells(i, 3).Value = "تحويل" Then
            With ListBox2
                .AddItem ws.Cells(i, 2).Value ' رقم الإذن
                .List(.ListCount - 1, 1) = ws.Cells(i, 6).Value ' اسم الصنف
                .List(.ListCount - 1, 2) = ws.Cells(i, 4).Value ' من مخزن
                .List(.ListCount - 1, 3) = ws.Cells(i, 9).Value ' الكمية
            End With
        End If
        If ListBox2.ListCount > 10 Then Exit For
    Next i
End Sub
Private Sub CommandButton_Undo_Click()
    Dim wsTrans As Worksheet: Set wsTrans = Sheets("Transactions")
    Dim wsAudit As Worksheet: Set wsAudit = Sheets("Audit_Log")
    Dim transID As Long
    Dim foundRow As Variant
    Dim nextAuditRow As Long
    
    ' التأكد من اختيار حركة من القائمة
    If ListBox2.ListIndex = -1 Then
        MsgBox "يرجى اختيار حركة من القائمة أولاً!", vbExclamation
        Exit Sub
    End If
    
    ' الحصول على رقم الإذن من العمود الأول في الـ ListBox
    transID = ListBox2.List(ListBox2.ListIndex, 0)
    
    ' البحث عن السجل في شيت الحركات
    foundRow = Application.Match(transID, wsTrans.Columns(2), 0)
    
    If Not IsError(foundRow) Then
        ' 1. تسجيل العملية في الـ Audit Log المخفي
        nextAuditRow = wsAudit.Cells(wsAudit.Rows.Count, 1).End(xlUp).Row + 1
        wsAudit.Cells(nextAuditRow, 1).Value = Now
        wsAudit.Cells(nextAuditRow, 2).Value = transID
        wsAudit.Cells(nextAuditRow, 6).Value = Application.UserName
        wsAudit.Cells(nextAuditRow, 7).Value = "تراجع عبر اليوزرفورم"
        
        ' 2. حذف السجل
        wsTrans.Rows(foundRow).Delete
        
        MsgBox "تم التراجع عن التحويل رقم " & transID & " بنجاح.", vbInformation
        
        ' 3. تحديث القائمة فوراً
        Call FillUndoList
    End If
End Sub

 

تم تعديل منذ 2 ساعات بواسطه mahmoud nasr alhasany