Untitled
unknown
plain_text
a year ago
36 kB
14
Indexable
' =============== تعریف متغیرهای عمومی در سطح ماژول ===============
' این متغیرها در تمام ساب روتین های ما قابل دسترس هستند
Option Explicit
' =============== ساب روتین برای افزودن کالا به سبد خرید ===============
Sub AddToCart()
' تعریف شیت ها برای دسترسی راحت تر
Dim wsPOS As Worksheet
Dim wsProducts As Worksheet
Set wsPOS = ThisWorkbook.Sheets("صندوق")
Set wsProducts = ThisWorkbook.Sheets("کالاها")
' تعریف متغیرها
Dim productCode As String
Dim quantity As Long
Dim productRow As Variant ' برای پیدا کردن ردیف محصول
Dim cartRow As Long ' اولین ردیف خالی در سبد خرید
Dim currentStock As Long
' خواندن مقادیر ورودی از شیت صندوق
productCode = wsPOS.Range("C4").Value
' بررسی اینکه آیا تعداد یک عدد معتبر است یا نه
If Not IsNumeric(wsPOS.Range("C5").Value) Or wsPOS.Range("C5").Value <= 0 Then
MsgBox "لطفاً تعداد را به درستی وارد کنید.", vbExclamation, "خطا در تعداد"
Exit Sub
End If
quantity = CLng(wsPOS.Range("C5").Value)
' بررسی خالی نبودن کد کالا
If productCode = "" Then
MsgBox "لطفاً کد کالا را وارد کنید.", vbExclamation, "کد کالا خالی است"
Exit Sub
End If
' جستجوی کد کالا در شیت کالاها
productRow = Application.Match(productCode, wsProducts.Range("A:A"), 0)
' اگر کالا پیدا نشد
If IsError(productRow) Then
MsgBox "کالایی با این کد پیدا نشد!", vbCritical, "خطا"
Exit Sub
End If
' بررسی موجودی کالا
currentStock = wsProducts.Cells(productRow, 4).Value ' ستون D موجودی است
If currentStock < quantity Then
MsgBox "موجودی این کالا کافی نیست!" & vbCrLf & "موجودی فعلی: " & currentStock, vbCritical, "خطا در موجودی"
Exit Sub
End If
' پیدا کردن اولین ردیف خالی در سبد خرید شیت صندوق
cartRow = wsPOS.Cells(wsPOS.Rows.Count, "A").End(xlUp).Row + 1
If cartRow < 10 Then cartRow = 10 ' سبد خرید از ردیف 10 شروع می شود
' وارد کردن اطلاعات کالا در سبد خرید
wsPOS.Cells(cartRow, 1).Value = productCode ' کد کالا
wsPOS.Cells(cartRow, 2).Value = wsProducts.Cells(productRow, 2).Value ' نام کالا
wsPOS.Cells(cartRow, 3).Value = quantity ' تعداد
wsPOS.Cells(cartRow, 4).Value = wsProducts.Cells(productRow, 3).Value ' قیمت واحد
wsPOS.Cells(cartRow, 5).Formula = "=C" & cartRow & "*D" & cartRow ' مبلغ کل
' پاک کردن سلول های ورودی برای محصول بعدی
wsPOS.Range("C4:C5").ClearContents
wsPOS.Range("C4").Select ' فوکوس روی سلول کد کالا
End Sub
' =============== ساب روتین برای نهایی کردن فاکتور ===============
Sub FinalizeInvoice()
' تعریف شیت ها
Dim wsPOS As Worksheet
Dim wsSales As Worksheet
Dim wsProducts As Worksheet
Set wsPOS = ThisWorkbook.Sheets("صندوق")
Set wsSales = ThisWorkbook.Sheets("فروشها")
Set wsProducts = ThisWorkbook.Sheets("کالاها")
' تعریف متغیرها
Dim invoiceNum As String
Dim saleDate As Date
Dim cartLastRow As Long
Dim salesNewRow As Long
Dim i As Long
Dim productRow As Variant
' بررسی خالی نبودن سبد خرید
cartLastRow = wsPOS.Cells(wsPOS.Rows.Count, "A").End(xlUp).Row
If cartLastRow < 10 Then
MsgBox "سبد خرید خالی است!", vbExclamation, "خطا"
Exit Sub
End If
' ساخت شماره فاکتور منحصر به فرد بر اساس تاریخ و ساعت
invoiceNum = Format(Now, "YYYYMMDD-HHMMSS")
saleDate = Now
' حلقه برای ثبت هر آیتم از سبد خرید در شیت فروش ها
For i = 10 To cartLastRow
' پیدا کردن اولین ردیف خالی در شیت فروش ها
salesNewRow = wsSales.Cells(wsSales.Rows.Count, "A").End(xlUp).Row + 1
' ثبت اطلاعات در شیت فروش ها
wsSales.Cells(salesNewRow, 1).Value = invoiceNum
wsSales.Cells(salesNewRow, 2).Value = saleDate
wsSales.Cells(salesNewRow, 3).Value = wsPOS.Cells(i, 1).Value ' کد کالا
wsSales.Cells(salesNewRow, 4).Value = wsPOS.Cells(i, 2).Value ' نام کالا
wsSales.Cells(salesNewRow, 5).Value = wsPOS.Cells(i, 3).Value ' تعداد
wsSales.Cells(salesNewRow, 6).Value = wsPOS.Cells(i, 4).Value ' قیمت واحد
wsSales.Cells(salesNewRow, 7).Value = wsPOS.Cells(i, 5).Value ' مبلغ کل
' آپدیت موجودی انبار
productRow = Application.Match(wsPOS.Cells(i, 1).Value, wsProducts.Range("A:A"), 0)
If Not IsError(productRow) Then
wsProducts.Cells(productRow, 4).Value = wsProducts.Cells(productRow, 4).Value - wsPOS.Cells(i, 3).Value
End If
Next i
' پاک کردن سبد خرید در شیت صندوق
wsPOS.Range("A10:E" & cartLastRow).ClearContents
' نمایش پیام موفقیت
MsgBox "فاکتور با شماره " & invoiceNum & " با موفقیت ثبت شد.", vbInformation, "ثبت موفق"
End Sub
' =============== ساب روتین برای پاک کردن سبد خرید ===============
Sub ClearCart()
Dim wsPOS As Worksheet
Set wsPOS = ThisWorkbook.Sheets("صندوق")
Dim cartLastRow As Long
cartLastRow = wsPOS.Cells(wsPOS.Rows.Count, "A").End(xlUp).Row
If cartLastRow < 10 Then Exit Sub ' اگر سبد خالی بود کاری نکن
wsPOS.Range("A10:E" & cartLastRow).ClearContents
wsPOS.Range("C4:C5").ClearContents
MsgBox "سبد خرید پاک شد.", vbInformation, "انجام شد"
End Sub
Editor is loading...
Leave a Comment