برنامج محاسبة لمحلات الملابس بالأكسل | تحكم كامل في المبيعات والمخزون

نظام مبيعات ومخزون في Excel بـ VBA — الكود مع الشرح (حصري)

هذه المقالة تشرح وحدة VBA متكاملة: دوال مساعدة، أحداث Worksheet_Change لشاشات الإدخال، إجراءات الترحيل (PostPurchase / PostSale / PostReturn / PostReturn_Linked)، أزرار تحميل الصور، حماية الأوراق، وتقارير الأرباح. بعد كل جزء سأضع فقرة توضيحية عن وظيفته وكيفية استخدامه أو تخصيصه.

1) رأس الموديول والإعدادات العامة + دوال المساعدة

Option Explicit

‘ —————————
‘ إعداد عام: صف بداية البيانات (إذا تبي تغيّره غيّر الرقم هنا)
Public Const DATA_START_ROW As Long = 3
Public Const MASTER_PWD As String = “CHANGE_THIS_PASSWORD” ‘ <- غيّرها لكلمة سر آمنة خاصة بك
‘ —————————

‘ — دالة تبحث عن كود صنف في عمود محدد (البحث يبدأ من DATA_START_ROW)
Function FindRowByCode(ws As Worksheet, code As String, codeCol As Long) As Long
Dim rng As Range, f As Range
If Trim(code) = “” Then
FindRowByCode = 0
Exit Function
End If
Set rng = ws.Range(ws.Cells(DATA_START_ROW, codeCol), ws.Cells(ws.Rows.Count, codeCol))
On Error Resume Next
Set f = rng.Find(What:=Trim(code), LookIn:=xlValues, LookAt:=xlWhole)
On Error GoTo 0
If Not f Is Nothing Then FindRowByCode = f.Row Else FindRowByCode = 0
End Function

‘ — ترجع أول صف فارغ للبيانات (تبدأ من DATA_START_ROW)
Function NextDataRow(ws As Worksheet, keyCol As Long) As Long
Dim lastRow As Long
lastRow = ws.Cells(ws.Rows.Count, keyCol).End(xlUp).Row
If lastRow < DATA_START_ROW Then
NextDataRow = DATA_START_ROW
Else
NextDataRow = lastRow + 1
End If
End Function

الشرح (دوال المساعدة):

  • Option Explicit يجبرك تعلن المتغيرات صريحًا — خطوة مهمة لتقليل الأخطاء الإملائية في أسماء المتغيرات.

  • DATA_START_ROW ثابت يحدد من أين تبدأ بيانات الجداول (عادة صف 3 لأن الصفوف فوقه رؤوس). تغييره مركزي وسيسهل إعادة استخدام الكود لو كانت جداولك تبدأ في صف آخر.

  • MASTER_PWD ثابت مركزي لاستخدامه في إجراءات الحماية/فك الحماية — غيّره فورًا قبل نشر الملف. لا تترك كلمة السر نصاً واضحاً في ملف تشاركه علناً.

  • FindRowByCode(ws, code, codeCol) تقوم بالبحث عن قيمة code في عمود رقمه codeCol داخل الورقة ws وتُرجع رقم الصف إن وجد، أو 0 إن لم يجد. تستخدم Find مع LookAt:=xlWhole للبحث المطابق تمامًا. تُستخدم هذه الدالة كثيرًا لتحديد صف الصنف في ورقة stock.

  • NextDataRow(ws, keyCol) ترجع أول صف فارغ لإضافة سجل جديد بطريقة آمنة (لا تكتب فوق بيانات موجودة). تعتمد على عمود مرجعي keyCol للعثور على آخر صف مستخدم.

نصيحة عملية: احفظ هذا الجزء في موديول عام (Module) لأن الدوال تستخدم من أكثر من إجراء.

اضغط هنا لشراء البرنامج

2) Worksheet_Change في شاشة المبيعات sales_rec (التعامل مع الكود/الاسم/الكمية/الخصم)

هذا الحدث يوضع داخل كود الورقة sales_rec (اضغط يمين على اسم الورقة → View Code → ألصق الكود داخل موديل الورقة).

Private Sub Worksheet_Change(ByVal Target As Range)
Dim wsStock As Worksheet
Dim f As Range
Dim code As String, itemName As String
Dim qty As Double, price As Double, discount As DoubleSet wsStock = ThisWorkbook.Worksheets(“stock”)

‘ اهتم فقط بالتغييرات في G6 أو G8 أو G16 أو G20
If Intersect(Target, Me.Range(“G6,G8,G16,G20”)) Is Nothing Then Exit Sub

Application.EnableEvents = False

‘ إذا تغيّر الكود G6 -> اطلع الاسم والسعر
If Not Intersect(Target, Me.Range(“G6”)) Is Nothing Then
code = Trim(Me.Range(“G6”).Value)
If code <> “” Then
Set f = wsStock.Range(“A3:A” & wsStock.Cells(wsStock.Rows.Count, “A”).End(xlUp).Row).Find(code, LookIn:=xlValues, LookAt:=xlWhole)
If Not f Is Nothing Then
Me.Range(“G8”).Value = wsStock.Cells(f.Row, “B”).Value ‘ اسم الصنف
Me.Range(“G18”).Value = wsStock.Cells(f.Row, “H”).Value ‘ سعر البيع
Else
Me.Range(“G8”).ClearContents
Me.Range(“G18”).ClearContents
End If
End If
End If

‘ إذا تغيّر الاسم G8 -> اطلع الكود والسعر
If Not Intersect(Target, Me.Range(“G8”)) Is Nothing Then
itemName = Trim(Me.Range(“G8”).Value)
If itemName <> “” Then
Set f = wsStock.Range(“B3:B” & wsStock.Cells(wsStock.Rows.Count, “B”).End(xlUp).Row).Find(itemName, LookIn:=xlValues, LookAt:=xlWhole)
If Not f Is Nothing Then
Me.Range(“G6”).Value = wsStock.Cells(f.Row, “A”).Value ‘ كود الصنف
Me.Range(“G18”).Value = wsStock.Cells(f.Row, “H”).Value ‘ سعر البيع
Else
Me.Range(“G6”).ClearContents
Me.Range(“G18”).ClearContents
End If
End If
End If

‘ حساب الإجمالي تلقائياً عند تغيير الكمية أو الخصم
If Not Intersect(Target, Me.Range(“G16,G20”)) Is Nothing Then
qty = Val(Me.Range(“G16”).Value)
price = Val(Me.Range(“G18”).Value)
discount = Val(Me.Range(“G20”).Value)
If qty > 0 And price > 0 Then
Me.Range(“G22”).Value = (qty * price) – discount
Else
Me.Range(“G22”).ClearContents
End If
End If

Application.EnableEvents = True
End Sub

الشرح (Worksheet_Change — sales_rec):

  • هذا الإيفينت يتتبع تغييرات المستخدم داخل الخلايا المحددة (G6,G8,G16,G20) فقط لتقليل العمل غير الضروري.

  • عند تعديل كود الصنف (G6): يبحث في ورقة stock عن الكود في العمود A من الصف 3 نزولًا. إذا وجده، يملأ اسم الصنف (G8) وسعر البيع (G18) تلقائيًا. إن لم يجده يتم مسح الحقول ذات الصلة.

  • عند تعديل اسم الصنف (G8): نفس المنطق لكن البحث في العمود B للعثور على الكود المقابل وملء الحقول. هذا يسهل الإدخال إما بالكود أو بالاسم.

  • عند تعديل الكمية (G16) أو الخصم (G20): يُعيد حساب الإجمالي (G22) بالصيغة (كمية × سعر) − خصم. يستخدم Val() لتحويل النص إلى رقم بأمان.

  • Application.EnableEvents = False/True تُستخدم لمنع حدوث تكرار (recursion) — مهم جدًا لأن تعديل الخلايا داخل الحدث سيؤدي إلى استدعاء الحدث نفسه إن لم تقم بإيقاف الأحداث مؤقتًا.

نصيحة: لو عندك أعمدة إضافية (مثل ضريبة أو خصم إضافي) أضف خلاياها إلى Intersect وحدث معادلة الإجمالي accordingly.

3) Worksheet_Change في شاشة المشتريات purch_rec (حساب إجمالي الشراء)

هذا الحدث يوضع داخل كود ورقة purch_rec.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim qty As Double, price As DoubleOn Error GoTo SafeExit

‘ نفّذ الكود فقط لو الخلية المتغيرة I18 (كمية) أو I20 (سعر الشراء)
If Not Intersect(Target, Me.Range(“I18,I20”)) Is Nothing Then
Application.EnableEvents = False

qty = Val(Me.Range(“I18”).Value)
price = Val(Me.Range(“I20”).Value)

‘ لو فيه بيانات صحيحة احسب، غير كده امسح
If qty > 0 And price > 0 Then
Me.Range(“I22”).Value = qty * price
Else
Me.Range(“I22”).ClearContents
End If
End If

SafeExit:
Application.EnableEvents = True
End Sub

الشرح (Worksheet_Change — purch_rec):

  • يراقب تغييرات كمية الشراء (I18) وسعر الشراء (I20) ويحسب الإجمالي (I22).

  • بسيط وفعال لتجنب الأخطاء في حساب تكلفة الشراء قبل الترحيل.

4) زر الصورة Button21_Click — تحميل وعرض صورة الصنف من مسار مخزن في ورقة stock

Sub Button21_Click()
Dim wsStock As Worksheet
Dim wsSalesRec As Worksheet
Dim code As String
Dim imagePath As String
Dim imgObj As Picture’ تعيين الشيتات
Set wsStock = ThisWorkbook.Sheets(“stock”)
Set wsSalesRec = ThisWorkbook.Sheets(“sales_rec”)

‘ الحصول على الكود من الخانة G6 في شيت sales_rec
code = wsSalesRec.Range(“G6”).Value

‘ الحصول على مسار الصورة من العمود L في شيت stock بناءً على الكود
Dim lastRow As Long
lastRow = wsStock.Cells(wsStock.Rows.Count, “A”).End(xlUp).Row
Dim i As Long
For i = 3 To lastRow
If wsStock.Cells(i, “A”).Value = code Then
imagePath = wsStock.Cells(i, “L”).Value
Exit For
End If
Next i

‘ فتح الصورة وإظهارها في المربع Image1 في شيت sales_rec
If imagePath <> “” Then
Set imgObj = wsSalesRec.Pictures.Insert(imagePath)
With imgObj
.ShapeRange.LockAspectRatio = msoFalse
.Width = wsSalesRec.Shapes(“Image1”).Width
.Height = wsSalesRec.Shapes(“Image1”).Height
.Top = wsSalesRec.Shapes(“Image1”).Top
.Left = wsSalesRec.Shapes(“Image1”).Left
End With
Else
On Error Resume Next
wsSalesRec.Shapes(“Image1”).Fill.Transparency = 1
If Err.Number <> 0 Then
MsgBox “لا يوجد مسار للصورة لهذا الكود.”
End If
On Error GoTo 0
End If
End Sub

الشرح (Button21_Click):

  • يبحث في ورقة stock عمود L عن مسار الصورة الموافقة لكود الصنف الموجود في sales_rec!G6.

  • إذا وُجد، يُدرج الصورة في الشيت sales_rec ويطابق أبعاد ومكان عنصر Image1 (شكل موجود مسبقًا). هذا مفيد لعرض صورة الصنف في شاشة الإدخال.

  • ملاحظة: Pictures.Insert يتوقع مسار ملف محلي أو مسار شبكي متاح. تأكد أن المسارات صحيحة وأن المستخدم لديه صلاحيات الوصول للملف.

  • تحذير عملي: كل Insert يضيف صورة جديدة كـ Picture مستقل — لو تريد استبدال الصورة السابقة ستحتاج لحذف الصور القديمة قبل الإدراج أو إعادة استخدامها بدل الإدراج المتكرر.

5) ماكروّات التنقل (Macro1..Macro9) وماكرو الترحيل المؤرشف sales_rec (نسخة أوتوماتيك سابقة)

Sub Macro1()
Sheets(“stock”).Select
End Sub
Sub Macro2()
Sheets(“sales”).Select
End Sub
‘ … حتى Macro9
Sub Macro9()
Sheets(“report”).Select
End Sub

الشرح (ماكروّات التنقل):

  • سلسة بسيطة لتسهيل التنقل بين الأوراق من أزرار على واجهة home أو أي لوحة. ضع كل زر في الواجهة ليستدعي الماكرو المناسب.

  • تعمل كاختصارات ولا تحتوي منطق بيانات.

ماكرو sales_rec القديم (نسخة نسخه المستخدم في ملفك — وظيفته نقل القيم ونسخها في sheet “sales”)

Sub sales_rec()
Range(“G6,G8,G10,G12,G14,G16,G18,G20,G22,G24”).Select
Range(“G24”).Activate
Selection.Copy
Sheets(“sales”).Select
Range(Selection, Selection.End(xlDown)).Select
Range(“K1”).Select
Selection.End(xlDown).Select
Selection.End(xlToLeft).Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Range(“A1”).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Sheets(“sales_rec”).Select
ActiveCell.Offset(-18, 0).Range(“A1”).Select
Application.CutCopyMode = False
Selection.ClearContents
ActiveCell.Offset(4, 0).Range(“A1”).Select
Selection.ClearContents
ActiveCell.Offset(4, 0).Range(“A1”).Select
Selection.ClearContents
ActiveCell.Offset(2, 0).Range(“A1”).Select
Selection.ClearContents
ActiveCell.Offset(4, 0).Range(“A1”).Select
Selection.ClearContents
ActiveCell.Offset(4, 0).Range(“A1”).Select
Selection.ClearContents
End Sub

الشرح (ماكرو sales_rec القديم):

  • ماكرو يعتمد على تحديد النطاق ثم الانتقال لشيت sales ولصق القيم (Transpose) — طريقة قديمة لكنها تعمل. لكن بها نقاط ضعف: تعتمد على الخلايا النشطة والتنقل بالـ Select/Activate مما يجعلها هشة إذا تغيّر التصميم.

  • أنصح باستخدام إجراء PostSale (أسفله) لأنه أكثر أمانًا ومرونة ويكتب مباشرة للخلايا دون Select أو Paste.

6) Sub PostPurchase — ترحيل المشتريات وتحديث المخزون (كود منظم ومكتمل)

Sub PostPurchase()
On Error GoTo ErrHandler
Application.ScreenUpdating = False
Application.EnableEvents = FalseDim wsRec As Worksheet, wsP As Worksheet, wsStock As Worksheet
Dim code As String, nm As String, purNo As Variant, pDate As Variant, supp As String
Dim qty As Double, price As Double, tot As Double, pay As String
Dim lastRow As Long, r As Long, newR As Long

Set wsRec = ThisWorkbook.Worksheets(“purch_rec”)
Set wsP = ThisWorkbook.Worksheets(“purch”)
Set wsStock = ThisWorkbook.Worksheets(“stock”)

code = Trim(wsRec.Range(“I8”).Value)
nm = wsRec.Range(“I10”).Value
purNo = wsRec.Range(“I12”).Value
pDate = wsRec.Range(“I14”).Value
supp = wsRec.Range(“I16”).Value
qty = Val(wsRec.Range(“I18”).Value)
price = Val(wsRec.Range(“I20”).Value)
tot = Val(wsRec.Range(“I22”).Value)
pay = wsRec.Range(“I24”).Value

If code = “” Or qty <= 0 Then
MsgBox “الرجاء إدخال كود الصنف والكمية (أكبر من صفر).”, vbExclamation
GoTo Cleanup
End If

lastRow = NextDataRow(wsP, 2) ‘ بداية الصف 3 + العمود المرجعي B (2)
With wsP
.Cells(lastRow, “A”).Value = supp
.Cells(lastRow, “B”).Value = code
.Cells(lastRow, “C”).Value = nm
.Cells(lastRow, “D”).Value = purNo
.Cells(lastRow, “E”).Value = pDate
.Cells(lastRow, “F”).Value = supp
.Cells(lastRow, “G”).Value = qty
.Cells(lastRow, “H”).Value = price
.Cells(lastRow, “I”).Value = tot
.Cells(lastRow, “J”).Value = pay
End With

‘ تحديث المخزون
r = FindRowByCode(wsStock, code, 1) ‘ كود في العمود A = 1
If r > 0 Then
wsStock.Cells(r, “I”).Value = Val(wsStock.Cells(r, “I”).Value) + qty ‘ عمود I = كمية بالمخزن
If price > 0 Then wsStock.Cells(r, “F”).Value = price ‘ عمود F = سعر الشراء
If IsDate(pDate) Then wsStock.Cells(r, “J”).Value = pDate ‘ تاريخ التوريد
Else
newR = NextDataRow(wsStock, 1)
wsStock.Cells(newR, “A”).Value = code
wsStock.Cells(newR, “B”).Value = nm
wsStock.Cells(newR, “E”).Value = supp
wsStock.Cells(newR, “F”).Value = price
wsStock.Cells(newR, “I”).Value = qty
If IsDate(pDate) Then wsStock.Cells(newR, “J”).Value = pDate
End If

‘ تنظيف شاشة الإدخال
wsRec.Range(“I8,I10,I12,I14,I16,I18,I20,I22,I24”).ClearContents

MsgBox “تم ترحيل الشراء وتحديث المخزون بنجاح.”, vbInformation

Cleanup:
Application.EnableEvents = True
Application.ScreenUpdating = True
Exit Sub

ErrHandler:
MsgBox “خطأ في PostPurchase: ” & Err.Description, vbCritical
Resume Cleanup
End Sub

الشرح (PostPurchase):

  • يقرأ الحقول من شاشة purch_rec، يتحقق من صحة الكود والكمية، ثم يضيف صفًا في شيت purch.

  • في تحديث المخزون: إن وجد الصنف في stock (باستخدام FindRowByCode)، يعزز الكمية ويحدث سعر الشراء وتاريخ التوريد إن أمكن. إن لم يوجد الصنف يضيف صفًا جديدًا بالمعلومات الأساسية.

  • بعد الترحيل ينظف شاشة الإدخال. يُظهر رسالة تأكيد عند النجاح.

  • تصميم هذا الإجراء يجعل إدارة المشتريات آلية ويساعد في تتبع التوريدات وتاريخها.

7) Sub PostSale — النسخة المكتملة (ترحيل مبيعات، خصم من المخزون، تحذير الكمية)

هذا هو الإجراء الذي طلبت نسخه مكتملة ومتوافقة. ألصقه في Module العام (أو استعمله كـ Public Sub).

Sub PostSale()
On Error GoTo ErrHandler
Application.ScreenUpdating = False
Application.EnableEvents = FalseDim wsRec As Worksheet, wsS As Worksheet, wsStock As Worksheet
Dim code As String, nm As String, invNo As Variant, sDate As Variant, cust As String
Dim qty As Double, price As Double, disc As Double, tot As Double, pay As String
Dim lastRow As Long, r As Long, newR As Long

 

Set wsRec = ThisWorkbook.Worksheets(“sales_rec”)

Set wsS = ThisWorkbook.Worksheets(“sales”)
Set wsStock = ThisWorkbook.Worksheets(“stock”)

 

‘ قراءة قيم الشاشة مع Trim للحماية من الفراغات

code = Trim(wsRec.Range(“G6”).Value)
nm = Trim(wsRec.Range(“G8”).Value)
invNo = Trim(wsRec.Range(“G10”).Value)
sDate = wsRec.Range(“G12”).Value
cust = Trim(wsRec.Range(“G14”).Value)
qty = Val(wsRec.Range(“G16”).Value)
price = Val(wsRec.Range(“G18”).Value)
disc = Val(wsRec.Range(“G20”).Value)
tot = Val(wsRec.Range(“G22”).Value)
pay = Trim(wsRec.Range(“G24”).Value)

‘ تحقق من البيانات الأساسية

If code = “” Then
MsgBox “الرجاء إدخال كود الصنف.”, vbExclamation
GoTo Cleanup
End If
If qty <= 0 Then
MsgBox “الرجاء إدخال كمية صحيحة أكبر من صفر.”, vbExclamation
GoTo Cleanup
End If
If price <= 0 Then
MsgBox “الرجاء التأكد من وجود سعر صالح للصنف.”, vbExclamation
GoTo Cleanup
End If

‘ إذا كان الإجمالي غير محسوب حسابيًا، أعاده احتساب للتأكد
If tot <= 0 Then
tot = (qty * price) – disc
End If

‘ إعداد الصف الجديد في شيت المبيعات
lastRow = NextDataRow(wsS, 1)
With wsS
.Cells(lastRow, “A”).Value = code
.Cells(lastRow, “B”).Value = nm
.Cells(lastRow, “C”).Value = invNo
.Cells(lastRow, “D”).Value = sDate
.Cells(lastRow, “E”).Value = IIf(Trim(cust) = “”, “عميل نقدي”, cust)
.Cells(lastRow, “F”).Value = qty
.Cells(lastRow, “G”).Value = price
.Cells(lastRow, “H”).Value = disc
.Cells(lastRow, “I”).Value = tot
.Cells(lastRow, “J”).Value = pay
End With

‘ تحديث المخزون (نقص)
r = FindRowByCode(wsStock, code, 1)
If r > 0 Then
‘ تحقق من وجود كمية كافية في المخزون (اختياري)
Dim currentQty As Double
currentQty = Val(wsStock.Cells(r, “I”).Value)
If currentQty < qty Then
‘ نعرض تحذير ونطلب تأكيد
If MsgBox(“الكمية بالمخزون أقل من المباعة. هل تريد المتابعة والتسجيل؟”, vbExclamation + vbYesNo) = vbNo Then
wsS.Rows(lastRow).ClearContents
GoTo Cleanup
End If
End If

wsStock.Cells(r, “I”).Value = currentQty – qty
If IsDate(sDate) Then wsStock.Cells(r, “K”).Value = sDate
Else
‘ إضافة صف جديد بمخزون سلبي لو غير موجود
newR = NextDataRow(wsStock, 1)
wsStock.Cells(newR, “A”).Value = code
wsStock.Cells(newR, “B”).Value = nm
wsStock.Cells(newR, “I”).Value = -qty
If IsDate(sDate) Then wsStock.Cells(newR, “K”).Value = sDate
End If

‘ تنظيف شاشة الإدخال وإرجاع القيمة الافتراضية للعميل النقدي
wsRec.Range(“G6,G8,G10,G12,G16,G18,G20,G22,G24”).ClearContents
wsRec.Range(“G14”).Value = “عميل نقدي”

MsgBox “تم ترحيل الفاتورة وتحديث المخزون بنجاح.”, vbInformation

Cleanup:
Application.EnableEvents = True
Application.ScreenUpdating = True
Exit Sub

ErrHandler:
MsgBox “خطأ في PostSale: ” & Err.Description, vbCritical
Resume Cleanup
End Sub

الشرح (PostSale — النسخة المكتملة):

  • يضمن هذا الإجراء ترحيل الفاتورة بأمان: فحص الحقول، إعادة حساب الإجمالي إذا لم يُحسب، إضافة السجل لورقة sales ثم تعديل الكمية في stock.

  • يتضمن تحذيرًا إن كانت الكمية في المخزون أقل من المباعة ويعطي المستخدم خيار الإلغاء. هذا يوازن بين مرونة العمل والحماية من الأخطاء.

  • إن لم يوجد الصنف في stock يضيف صفًا جديدًا مع كمية سالبة — مفيد لمعرفة الأصناف المباعة قبل إضافتها إلى المخزون.

  • بعد النجاح يُنظف شاشة الإدخال ويُرجع “عميل نقدي”.

نصيحة تنفيذية: لو تريد رفض تنفيذ البيع نهائيًا عند وجود كمية ناقصة (بدلاً من تحذير)، غير رسالة الـ MsgBox لإجبار المستخدم على تعديل الكمية أولاً.

8) Sub PostReturn و PostReturn_Linked — تسجيل المرتجعات وتعديل الفاتورة الأصلية

PostReturn (بسيط — يسجل المرتجع ويزيد المخزون)

Sub PostReturn()
‘ (كود مطابق لما أرفقته سابقاً — يسجل المرتجع في sheet “returns” ويزيد المخزون)
‘ يقوم بتنظيف شاشة الإدخال ويعيد “عميل نقدي”
End Sub

الشرح (PostReturn):

  • يتم ترحيل بيانات المرتجع إلى شيت returns ثم زيادة الكمية في stock. يناسب حالة تسجيل مرتجع مستقل دون تعديل الفاتورة الأصلية.

PostReturn_Linked (مترابط — يعدل الفاتورة الأصلية في sheet “sales” ثم يحدث المخزون)

Sub PostReturn_Linked()
‘ (كود كامل في الموديول الذي أرسلته: يقرأ G6..G24 من returns_rec)
‘ 1) يسجّل المرتجع في returns
‘ 2) يبحث في sheet “sales” عن السطر المطابق (كود + رقم الفاتورة) ويعدل الكمية والإجمالي
‘ 3) يحدث المخزون بزيادة الكمية
‘ 4) ينضف شاشة الإدخال ويعرض رسالة نجاح أو خطأ إن لم يجد الفاتورة
End Sub

الشرح (PostReturn_Linked):

  • هذه النسخة مميزة لأنها لا تكتفي بتسجيل المرتجع، بل تبحث عن الفاتورة الأصلية في شيت المبيعات (sales) وتُقلِّل الكمية والإجمالي لديها لتعكس المرتجع. هذا مهم للمحافظة على سجل مبيعات صحيح.

  • إن لم تجد الفاتورة الأصلية تُنبه المستخدم وتوقف العملية — هذا حماية قوية ضد أخطاء التسجيل.

  • بعد تعديل الفاتورة يُزاد المخزون بالكمية المرتجعة.

نصيحة: احتفظ بنسخة من شيت sales أو سجل للتغييرات قبل تشغيل PostReturn_Linked لأول مرة على بيانات حقيقية.

9) ResetSalesForm و ApplyProtection و SwitchUser و أدوات الحماية

Sub ResetSalesForm()
On Error Resume Next
With ThisWorkbook.Worksheets(“sales_rec”)
.Range(“G6,G8,G10,G12,G16,G18,G20,G22,G24”).ClearContents
.Range(“G14”).Value = “عميل نقدي”
End With
With ThisWorkbook.Worksheets(“returns_rec”)
.Range(“G6,G8,G10,G12,G16,G18,G20,G22,G24”).ClearContents
.Range(“G14”).Value = “عميل نقدي”
End With
End SubSub ApplyProtection()
Dim ws As Worksheet
Dim PWD As String
PWD = MASTER_PWD ‘ استخدام الثابت الموحد

On Error Resume Next
For Each ws In ThisWorkbook.Worksheets
ws.Unprotect Password:=PWD
Next ws
On Error GoTo 0

‘ تفعيل القفل: نجعل الخلايا كلها مقفولة ثم نفتح خلايا شاشات الإدخال فقط
For Each ws In ThisWorkbook.Worksheets
ws.Cells.Locked = True
Next ws

With ThisWorkbook.Worksheets(“sales_rec”)
.Range(“G6,G8,G10,G12,G14,G16,G18,G20,G22,G24”).Locked = False
End With
With ThisWorkbook.Worksheets(“purch_rec”)
.Range(“I8,I10,I12,I14,I16,I18,I20,I22,I24”).Locked = False
End With
With ThisWorkbook.Worksheets(“returns_rec”)
.Range(“G6,G8,G10,G12,G14,G16,G18,G20,G22,G24”).Locked = False
End With

For Each ws In ThisWorkbook.Worksheets
ws.Protect Password:=PWD, UserInterfaceOnly:=True, AllowFiltering:=True
Next ws

MsgBox “تم تطبيق الحماية (عدل كلمة المرور في الكود إذا رغبت).”, vbInformation
End Sub

Sub SwitchUser()
Dim PWD As String
Dim ws As Worksheet
Dim managerMode As Boolean

managerMode = (ThisWorkbook.Worksheets(“home”).Visible = xlSheetVisible)

If managerMode = True Then
Call ShowEmployeeSheets
MsgBox “تم الرجوع لوضع الموظف.”, vbInformation
Else
PWD = InputBox(“ادخل كلمة المرور للدخول كمدير:”, “تبديل الدخول”)
If PWD = MASTER_PWD Then
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

For Each ws In ThisWorkbook.Worksheets
ws.Visible = xlSheetVisible
Next ws
ThisWorkbook.Worksheets(“home”).Activate

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

MsgBox “تم الدخول كمدير.”, vbInformation
Else
MsgBox “كلمة مرور غير صحيحة.”, vbCritical
End If
End If
End Sub

Sub UnprotectAllSheets()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
On Error Resume Next
ws.Unprotect Password:=MASTER_PWD
On Error GoTo 0
Next ws
End Sub

Sub ProtectAllSheets()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
On Error Resume Next
ws.Protect Password:=MASTER_PWD, DrawingObjects:=True, Contents:=True, Scenarios:=True
On Error GoTo 0
Next ws
End Sub

Sub ShowEmployeeSheets()
Dim ws As Worksheet
Dim adminSheets As Variant
adminSheets = Array(“home”, “report”, “profit_loss”)
For Each ws In ThisWorkbook.Worksheets
ws.Visible = xlSheetHidden
Next ws
Dim i As Long
For i = LBound(adminSheets) To UBound(adminSheets)
On Error Resume Next
ThisWorkbook.Worksheets(adminSheets(i)).Visible = xlSheetVisible
On Error GoTo 0
Next i
End Sub

الشرح (حماية وتبديل المستخدم):

  • ApplyProtection تفك الحماية ثم تعيد تطبيقها بحيث تكون خلايا إدخال النماذج مفتوحة فقط ويستطيع الماكروز الكتابة لأن UserInterfaceOnly:=True. لا تنسَ تغيير MASTER_PWD.

  • SwitchUser يوفّر طريقة بسيطة لتبديل بين وضع الموظف والوضع الإداري عبر كلمة مرور.

  • ShowEmployeeSheets تخفي أوراق المدير وتُظهر واجهة الموظف فقط. عدّل مصفوفة adminSheets حسب أوراقك الحساسة.

ملاحظة أمنية: لا تحفظ كلمة المرور في أماكن عامة. إذا كان الملف سيُشارك، فكّر في طرق أخرى للتحقق بدل حفظ كلمة سر في الكود (مثلاً تخزين هاش في مصدر خارجي).

10) تقرير الأرباح والخسائر UpdateProfitLoss — تجميع حسب شهور

Sub UpdateProfitLoss()
Const DATA_START_ROW As Long = 3
Const PWD As String = “CHANGE_THIS_PASSWORD”Dim wsS As Worksheet, wsP As Worksheet, wsN As Worksheet, wsSt As Worksheet, wsPL As Worksheet
Dim salesArr, purchArr, expArr, staffArr
Dim m As Long, i As Long, lastRow As Long
Dim salesTot(1 To 12) As Double, purchTot(1 To 12) As Double
Dim expTot(1 To 12) As Double, staffTot(1 To 12) As Double
Dim d As Variant

Set wsS = ThisWorkbook.Worksheets(“sales”)
Set wsP = ThisWorkbook.Worksheets(“purch”)
Set wsN = ThisWorkbook.Worksheets(“nfaqat”)
Set wsSt = ThisWorkbook.Worksheets(“staff”)
Set wsPL = ThisWorkbook.Worksheets(“profit_loss”)

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

wsS.Unprotect Password:=PWD
wsP.Unprotect Password:=PWD
wsN.Unprotect Password:=PWD
wsSt.Unprotect Password:=PWD
wsPL.Unprotect Password:=PWD

wsPL.Range(“B3:M6”).ClearContents

‘ (يتبع: جمع المبيعات، المشتريات، النفقات، الرواتب حسب الشهر، ثم كتابة النتائج)

wsS.Protect Password:=PWD
wsP.Protect Password:=PWD
wsN.Protect Password:=PWD
wsSt.Protect Password:=PWD
wsPL.Protect Password:=PWD

wsPL.Activate
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

MsgBox “تم تحديث تقرير الأرباح والخسائر.”, vbInformation
End Sub

الشرح (UpdateProfitLoss):

  • يقوم بتجميع مبيعات ومشتريات ونفقات ومرتبات شهرية ثم يكتب النتائج في profit_loss.

  • لا أنصح تشغيله على جداول ضخمة بدون اختبار لأن نسخ البيانات إلى مصفوفات ثم التكرار قد يستهلك وقتًا مع بيانات كبيرة — لكن الهيكل جيد للتقارير الشهرية.

11) أين ألصق الكود خطوة بخطوة (تعليمات عملية)

  1. افتح Excel → Alt + F11 لفتح محرر VBA.

  2. لإضافة الدوال العامة والإجراءات (PostSale, PostPurchase, Helpers) → Insert → Module → ألصق الكود كله في موديل جديد.

  3. لأحداث الورقة (Worksheet_Change) لـ sales_rec و purch_rec → في Project Explorer افتح الشيت المعني → دوبل كليك → ألصق كود الـ Worksheet_Change داخل هذا الـ Sheet module.

  4. احفظ الملف كـ Excel Macro-Enabled Workbook (*.xlsm).

  5. قبل الاختبار غيّر MASTER_PWD إلى كلمة سر قوية. اجري اختبار على نسخة من الملف.

12) نصائح فنية وأفضل ممارسات قبل التشغيل على بيانات حقيقية

  • نسخة احتياطية: لا تعمل على الملف الأصلي — جرب على نسخة.

  • تنظيف المدخلات: تأكد أن أعمدة stock مثل A (الكود), B (الاسم), H أو I (الأسعار والكميات) منسقة بشكل مناسب (نص/رقم).

  • التحقق من المسارات: لو تستخدم Button21_Click تأكد أن مسارات الصور صحيحة وملفات الصور متاحة.

  • سلوك الكميات السالبة: قرّر إن كنت تريد منع المبيعات التي تؤدي لمخزون سالب أم لا. الكود الآن يحذرك لكنه يسمح بالتسجيل.

  • سجلات التغيير (Audit log): لو مطلوب تتبع المستخدمين والتغييرات، أضف شيت audit_log وأدخل سجل مع التاريخ والمستخدم (Application.UserName) عند كل ترحيل.

اضغط هنا لشراء البرنامج