Untitled

 avatar
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