اذهب الي المحتوي
أوفيسنا

طلب مساعدة فى اصلاح كود VBA الخاص بحساب الارباح والتكلفة على طريقة FIFO

عمر ضاحى

بواسطه عمر ضاحى
في قسم الأكسيس Access

 مشاركة

الردود الموصى بها

عمر ضاحى

عمر ضاحى

قام بنشر
قام بنشر

         السادة / جميع اساتذتي الكرام      (حفظكم الله)

السلام عليكم ورحمة الله وبركاته 

تحيه طيبه وبعد؛
وكما هو موضح فى العنوان

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

(لكن هناك اصناف كثيره لا توجد معها اى مشكلة)

انا بحاجه الى مساعده فى حل هذه المشكلة 
ومن ضمن العينات التى بها مشكلة واضحه الصنف رقم ٣٥٦ والصنف رقم 19 والصنف رقم 3 وغيرها الكثير للاسف
فاريد حل لهذه المشكلة وافهم ما سبب هذه المشكلة
 ----  ----  ----  ----  ----  ----  ----  ----  ----  ----  ----  ----  ----  ----  ----  ----  ----  ----  ----  ----  ---- 
تنويه: يوجد نموذج بالمرفق وزر باسم بدء كود FIFO 
عند الضغط عليه يجب الانتظار حتى تنتهي دورة الاحتساب
----  ----  ----  ----  ----  ----  ----  ----  ----  ----  ----  ----  ----  ----  ----  ----  ----  ----  ----  ----  ---- 

تنويه اخر: القاعدة فيها عمليات بيع غير منطقية (الارصدة السالبة) وهي نتيجة

اخطأ فى الكود سابقة تركتها كما هي حتى يمكنني فيما بعد اصدار بها تقارير للاصلاح

----  ----  ----  ----  ----  ----  ----  ----  ----  ----  ----  ----  ----  ----  ----  ----  ----  ----  ----  ----  ---- 

اخر تنويه : 🙂 الكود وصل لهذا الشكل بعد مساعدة الذكاء الصناعي 🙂

----  ----  ----  ----  ----  ----  ----  ----  ----  ----  ----  ----  ----  ----  ----  ----  ----  ----  ----  ----  ---- 
نقطة اخيره : هل لدي احدكم طريقة احصل بها على ارصدة الفعلية للمخزون لجميع الاصناف
     مره واحده (خاصه ان هناك اكثر من جهاز يقومون بعمليات التسجيل)
    فكرت فى ان اعمل جدول داخلى وجدول فى القاعدة الخلفيه على السيرفر
    الجدول على السيرفر هيستلم اى حركه تتم (ادخالات او تعديلات او حذف)
    وفى هذا الجدول اعمل حقل رقمي بحيث اذا الجهاز رقم 1 عمل اى عملية ترسل للقاعده الخلفية
    برقم الجهاز 1 كمثال وهكذا مع باقي الاجهزة 
    ثم اعمل كود يقوم بتحديث الارصدة في الجدول المحلى بناءا على الجدول على الشبكه 
    لكن وجدت اني لم احل المشكلة لان ده هيعمل ضغط على السرفر وبالتبعية هتاخد وقت طويل طويل (لاني بعاني منها حاليا)
    فهل اجد عندكم اقتراح لحل هذه المشكلة؟
----  ----  ----  ----  ----  ----  ----  ----  ----  ----  ----  ----  ----  ----  ----  ----  ----  ----  ----  ----  ---- 

عارف ان موضوعي معقد وطويل لاني فعلا احبطة من كثرة التجارب الفاشلة

لكن كتبته لعل احدهم يستفاد من هذا الموضوع المعقد 🙂

 ----  ----  ----  ----  ----  ----  ----  ----  ----  ----  ----  ----  ----  ----  ----  ----  ----  ----  ----  ----  ---- 
صور توضيحية للمرفق (هنا اظهرت عينة وهو الصنف رقم 356)
PEpJIB.png

 



                                                                                                            ولكم جزيل الشكر

 

Database2_.rar

عمر ضاحى

عمر ضاحى

قام بنشر
  • الكاتب
قام بنشر
منذ ساعه, عمر ضاحى said:

نقطة اخيره : هل لدي احدكم طريقة احصل بها على ارصدة الفعلية للمخزون لجميع الاصناف
     مره واحده (خاصه ان هناك اكثر من جهاز يقومون بعمليات التسجيل)
    فكرت فى ان اعمل جدول داخلى وجدول فى القاعدة الخلفيه على السيرفر
    الجدول على السيرفر هيستلم اى حركه تتم (ادخالات او تعديلات او حذف)
    وفى هذا الجدول اعمل حقل رقمي بحيث اذا الجهاز رقم 1 عمل اى عملية ترسل للقاعده الخلفية
    برقم الجهاز 1 كمثال وهكذا مع باقي الاجهزة 
    ثم اعمل كود يقوم بتحديث الارصدة في الجدول المحلى بناءا على الجدول على الشبكه 
    لكن وجدت اني لم احل المشكلة لان ده هيعمل ضغط على السرفر وبالتبعية هتاخد وقت طويل طويل (لاني بعاني منها حاليا)
    فهل اجد عندكم اقتراح لحل هذه المشكلة؟

هذه الجذئية يمكنكم تجاهلها 
مؤقتا حتى اتحقق من نتيجة التجربة مش عارف رقم كام  😅

🌹

عمر ضاحى

عمر ضاحى

قام بنشر
  • الكاتب
قام بنشر
58 دقائق مضت, ابوخليل said:

وعليكم السلام ورحمة الله وبركاته

اصدار المرفق احدث .. لا يمكن فتحه

عندي 2010  32 بت

يبدو ان المثال 64

 

فعلا

يكفي مروركم الكريم 🌹

عمر ضاحى

عمر ضاحى

قام بنشر
  • الكاتب
قام بنشر
11 ساعات مضت, jjafferr said:

وانا كذلك، 

اصدار المرفق احدث .. لا يمكن فتحه

عندي 2010  32 بت

يشرفني مروركم استاذي الكريم 
سوف اقوم بتحميل نسخه 2010 32 بت وارفع لكم نسخه 

عمر ضاحى

عمر ضاحى

قام بنشر
  • الكاتب
قام بنشر

😂

بعد ما نزلت نسخه 2010 لقيت من المستحيل فعلا نقل البيانات لاني باستخدم ارقام كبيرة وعناصر مش موجوده غير فى النسخ الاحدث 
( يظهر اني كنت مسطول وانا باعمل كده 🤣 )

 

طيب محاول معرفش اذا كانت من الممكن ان تفيد ام لا 
هذا هو الكود كامل للموديول 
  

Option Compare Database
Option Explicit

Public ActiveMsgBox As Boolean
Public IsErrorMsg As Boolean


Public Function ProcessFIFO()
    'On Error GoTo HandleError

    Dim db As DAO.Database
    Dim tdf As DAO.TableDef
    Dim tableExists As Boolean
    Dim SQL As String
    Dim rst As DAO.Recordset
    
    Set db = CurrentDb()
    
    '===========================
    ' Create TblFifoStockLocal table if it doesn't exist
    ' Fields in English with new fields added:
    ' InvID, InvType, InvTypeName, ReturnPurchasedQty, ReturnSoldQty
    '===========================
    tableExists = False
    For Each tdf In db.TableDefs
        If tdf.Name = "TblFifoStockLocal" Then
            tableExists = True
            Exit For
        End If
    Next tdf
    
    If Not tableExists Then
        SQL = "CREATE TABLE TblFifoStockLocal (" & _
              "ID AUTOINCREMENT PRIMARY KEY, " & _
              "InvID TEXT(50), " & _
              "InvType LONG, " & _
              "InvTypeName TEXT(50), " & _
              "ItemCode LONG, " & _
              "ItemName TEXT(100), " & _
              "PurchasedQty Double, " & _
              "SoldQty Double, " & _
              "ReturnPurchasedQty Double, " & _
              "ReturnSoldQty Double, " & _
              "ActualBalance Double, " & _
              "PurchasePrice DOUBLE, " & _
              "SalePrice DOUBLE, " & _
              "Profit DOUBLE, " & _
              "CostOfGoodsSold DOUBLE, " & _
              "TotalOfGoodsPurchased DOUBLE, " & _
              "TransactionDate DATETIME" & _
              ");"
        db.Execute SQL, dbFailOnError
        db.TableDefs.Refresh
        Set tdf = db.TableDefs("TblFifoStockLocal")
        
        ' Update InvID field property to be Large Number (dbLongLong) - available in 64-bit
'        On Error Resume Next
'        tdf.Fields("InvID").Properties("FieldSize") = dbLongLong
'        On Error GoTo 0
        
        ' Set Caption and Description using helper function SetFieldProperty
        Dim fld As DAO.Field
        For Each fld In tdf.Fields
            Select Case fld.Name
                Case "ID"
                    SetFieldProperty fld, "Caption", "SN"
                    SetFieldProperty fld, "Description", "SN"
                Case "InvID"
                    SetFieldProperty fld, "Caption", "Invoice ID"
                    SetFieldProperty fld, "Description", "Invoice identification number"
                Case "InvType"
                    SetFieldProperty fld, "Caption", "Invoice Type"
                    SetFieldProperty fld, "Description", "1: Purchases, 2: Sales, 3: Purchase Returns, 4: Sales Returns"
                Case "InvTypeName"
                    SetFieldProperty fld, "Caption", "Invoice Type Name"
                    SetFieldProperty fld, "Description", "Invoice name according to type"
                Case "ItemCode"
                    SetFieldProperty fld, "Caption", "Item Number"
                    SetFieldProperty fld, "Description", "Item number as in source"
                Case "ItemName"
                    SetFieldProperty fld, "Caption", "Item Name"
                    SetFieldProperty fld, "Description", "Item name"
                Case "PurchasedQty"
                    SetFieldProperty fld, "Caption", "Purchased Quantity"
                    SetFieldProperty fld, "Description", "Total purchased quantity"
                Case "SoldQty"
                    SetFieldProperty fld, "Caption", "Sold Quantity"
                    SetFieldProperty fld, "Description", "Total sold quantity"
                Case "ReturnPurchasedQty"
                    SetFieldProperty fld, "Caption", "Purchase Return Quantity"
                    SetFieldProperty fld, "Description", "Total returned quantity from purchases"
                Case "ReturnSoldQty"
                    SetFieldProperty fld, "Caption", "Sales Return Quantity"
                    SetFieldProperty fld, "Description", "Total returned quantity from sales"
                Case "ActualBalance"
                    SetFieldProperty fld, "Caption", "Actual Balance"
                    SetFieldProperty fld, "Description", "Actual balance after operations"
                Case "PurchasePrice"
                    SetFieldProperty fld, "Caption", "Purchase Price"
                    SetFieldProperty fld, "Description", "Unit purchase price"
                Case "SalePrice"
                    SetFieldProperty fld, "Caption", "Sale Price"
                    SetFieldProperty fld, "Description", "Unit sale price"
                Case "Profit"
                    SetFieldProperty fld, "Caption", "Profit"
                    SetFieldProperty fld, "Description", "Difference between sale revenue and purchase cost"
                Case "CostOfGoodsSold"
                    SetFieldProperty fld, "Caption", "Cost of Goods Sold"
                    SetFieldProperty fld, "Description", "Total cost of goods sold"
                Case "TotalOfGoodsPurchased"
                    SetFieldProperty fld, "Caption", "Total Goods Sold"
                    SetFieldProperty fld, "Description", "Total of goods sold"
                Case "TransactionDate"
                    SetFieldProperty fld, "Caption", "Transaction Date"
                    SetFieldProperty fld, "Description", "Transaction registration date"
            End Select
        Next fld
    Else
        SQL = "DELETE FROM TblFifoStockLocal;"
        db.Execute SQL, dbFailOnError
    End If
    
    '===========================
    ' Create/Empty TblFifoRemaining table
    '===========================
    Dim tdfR As DAO.TableDef
    Dim TableExistsR As Boolean
    TableExistsR = False
    For Each tdfR In db.TableDefs
        If tdfR.Name = "TblFifoRemaining" Then TableExistsR = True: Exit For
    Next tdfR

    If Not TableExistsR Then
        SQL = "CREATE TABLE TblFifoRemaining (" & _
              "ID AUTOINCREMENT PRIMARY KEY, " & _
              "ItemCode LONG, " & _
              "InvID DOUBLE, " & _
              "InvNo TEXT(50), " & _
              "ItemName TEXT(100), " & _
              "InvDate DATETIME, " & _
              "RemainingQty Double, " & _
              "PurchasePrice DOUBLE, " & _
              "TotalCost DOUBLE);"
        db.Execute SQL, dbFailOnError
        db.TableDefs.Refresh
        Set tdfR = db.TableDefs("TblFifoRemaining")
        

        ' Set Caption and Description for fields
        For Each fld In tdfR.Fields
            Select Case fld.Name
                Case "ID":
                    SetFieldProperty fld, "Caption", "SN"
                    SetFieldProperty fld, "Description", "SN"
                Case "ItemCode":
                    SetFieldProperty fld, "Caption", "رقم الصنف"
                    SetFieldProperty fld, "Description", "رقم الصنف كما في المصدر"
                Case "InvID":
                    SetFieldProperty fld, "Caption", "معرف الفاتورة"
                    SetFieldProperty fld, "Description", "رقم معرف الفاتورة الأصلي للدُفعة"
                    SetFieldProperty fld, "Format", "0"
                Case "InvNo":
                    SetFieldProperty fld, "Caption", "رقم الفاتورة"
                    SetFieldProperty fld, "Description", "رقم الفاتورة الأصلي للدُفعة"
                Case "ItemName":
                    SetFieldProperty fld, "Caption", "اسم الصنف"
                    SetFieldProperty fld, "Description", "اسم الصنف"
                Case "InvDate":
                    SetFieldProperty fld, "Caption", "تاريخ الفاتورة"
                    SetFieldProperty fld, "Description", "تاريخ الفاتورة للدُفعة"
                Case "RemainingQty":
                    SetFieldProperty fld, "Caption", "الكمية المتبقية"
                    SetFieldProperty fld, "Description", "الرصيد المتبقي من الدُفعة بعد المعالجة"
                Case "PurchasePrice":
                    SetFieldProperty fld, "Caption", "سعر الشراء"
                    SetFieldProperty fld, "Description", "سعر شراء الوحدة للدُفعة"
                Case "TotalCost":
                    SetFieldProperty fld, "Caption", "التكلفة الإجمالية"
                    SetFieldProperty fld, "Description", "التكلفة الإجمالية للكمية المتبقية"
            End Select
        Next fld
    Else
        db.Execute "DELETE FROM TblFifoRemaining;", dbFailOnError
    End If
    
    '===========================
    ' Read query data and sort by
    ' ItemCode (LItemID) & InvDate & InvType
    '===========================
    SQL = "SELECT TblInvHead.InvID, TblInvHead.InvDate, TblInvHead.InvNo, " & _
          "TblInvHead.InvType, TblInvType.InvTypeName, TblInvDetails.ID, " & _
          "TblInvDetails.SN, TblInvDetails.LInvID, TblItems.ItemName, " & _
          "TblInvDetails.LItemID, TblInvDetails.Qty, TblInvDetails.PaPrice, " & _
          "TblInvDetails.SaPrice, TblInvDetails.Notes, TblInvDetails.LWhID, " & _
          "TblInvDetails.CurrQn, TblInvDetails.LInvIDPay, TblInvDetails.Done, " & _
          "TblItems.ImgLink, TblItems.IsActive " & _
          "FROM TblInvType " & _
          "INNER JOIN (TblInvHead INNER JOIN (TblItems INNER JOIN TblInvDetails ON TblItems.ItemCode = TblInvDetails.LItemID) " & _
          "ON TblInvHead.InvID = TblInvDetails.LInvID) " & _
          "ON TblInvType.InvTypeID = TblInvHead.InvType " & _
          "ORDER BY TblInvHead.InvDate, TblInvHead.InvType ,TblInvDetails.LItemID;"
'          Debug.Print SQL
'WHERE (((TblInvDetails.LItemID)=356))
    Set rst = db.OpenRecordset(SQL, dbOpenDynaset)
    
    '===========================
    ' Create FIFO list and Dictionary to track balance
    '===========================
    Dim fifoList As New Collection
    Dim dictBalance As Object
    Set dictBalance = CreateObject("Scripting.Dictionary")
    
    Dim currentBatch As Variant
    Dim pos As Long, availableQty As Long
    Dim LitemID As Long, Qty As Double
    Dim ItemName As String
    Dim PaPrice As Double, SaPrice As Double
    Dim InvDate As Date
    Dim InvType As Integer
    Dim xInvIDs As String
    Dim xInvNo As String
    Dim unitCost As Double, TotalCost As Double, profit As Double
    Dim CostOfGoodsSold As Double
    Dim TotalOfGoodsPurchased As Double
    Dim remainingSale As Double, remainingReturn As Double
    Dim i As Long, j As Long, foundIndex As Long
    Dim OrignalSaPrice As Double
    Dim chunkQty As Long
    Dim chunkCost As Double
    Dim chunkRevenue As Double
    Dim chunkProfit As Double
    Dim sqlChunk As String


    
    
    Do While Not rst.EOF
        LitemID = Nz(rst!LitemID, 0)
        ItemName = Nz(rst!ItemName, "")
        Qty = Nz(rst!Qty, 0)
        PaPrice = Nz(rst!PaPrice, 0)
        SaPrice = Nz(rst!SaPrice, 0)
        InvDate = Nz(rst!InvDate, Now())
        InvType = Nz(rst!InvType, 0)
        xInvIDs = Nz(rst!InvID, 0)
        xInvNo = Nz(rst!InvNo, 0)
        OrignalSaPrice = Nz(DLookup("[PaPrice]", "[TblInvDetails]", " [LInvID] =" & xInvIDs & "  And [LItemID] =" & LitemID & " "), 0)
        Select Case InvType
            Case 1  ' Purchases
                If dictBalance.Exists(LitemID) Then
                    dictBalance(LitemID) = dictBalance(LitemID) + Qty
                Else
                    dictBalance.Add LitemID, Qty
                End If
'                currentBatch = Array(LitemID, ItemName, Qty, PaPrice, InvDate)
                currentBatch = Array(LitemID, ItemName, Qty, PaPrice, InvDate, xInvIDs, xInvNo)
                fifoList.Add currentBatch
'                sql = "INSERT INTO TblFifoStockLocal " & _
'                        "(InvID, InvType, InvTypeName, ItemCode, ItemName, PurchasedQty, SoldQty, " & _
'                        "ReturnPurchasedQty, ReturnSoldQty, ActualBalance, PurchasePrice, SalePrice, " & _
'                        "Profit, CostOfGoodsSold, TotalOfGoodsPurchased, TransactionDate) " & _
'                        "VALUES (" & rst!InvID & ", " & rst!InvType & ", '" & rst!InvTypeName & "', " & _
'                        LitemID & ", '" & ItemName & "', " & Qty & ", 0, 0, 0, " & _
'                        dictBalance(LitemID) & ", " & PaPrice & ", 0, 0, 0, 0, #" & Format(InvDate, "mm/dd/yyyy") & "#);"
'                db.Execute sql, dbFailOnError
                
                SQL = "INSERT INTO TblFifoStockLocal " & _
                        "(InvID, InvType, InvTypeName, ItemCode, ItemName, PurchasedQty, SoldQty, " & _
                        "ReturnPurchasedQty, ReturnSoldQty, ActualBalance, PurchasePrice, SalePrice, " & _
                        "Profit, CostOfGoodsSold, TotalOfGoodsPurchased, TransactionDate) " & _
                        "VALUES (" & rst!InvID & ", " & InvType & ", '" & rst!InvTypeName & "', " & _
                        LitemID & ", '" & Replace(ItemName, "'", "''") & "', " & Qty & ", 0, 0, 0, " & _
                        dictBalance(LitemID) & ", " & PaPrice & ", 0, 0, 0, 0, #" & Format(InvDate, "mm\/dd\/yyyy") & "#);"
                db.Execute SQL, dbFailOnError

   Case 2  ' ====== Sales ======
    
    remainingSale = Qty

    ' 1) Find first batch in FIFO for the item
    foundIndex = 0
    For i = 1 To fifoList.count
        If fifoList(i)(0) = LitemID Then
            foundIndex = i
            Exit For
        End If
    Next i

    ' 2) Repeat until full sale quantity is processed
    Do While remainingSale > 0 And foundIndex > 0
        ' If list size changes making index out of range, exit
        If foundIndex > fifoList.count Then Exit Do

        currentBatch = fifoList(foundIndex)
        availableQty = currentBatch(2)

        If availableQty <= remainingSale Then
            ' Consume entire batch
            chunkQty = availableQty
            chunkCost = chunkQty * currentBatch(3)
            remainingSale = remainingSale - chunkQty
            fifoList.Remove foundIndex

        Else
            ' Consume part of the batch
            chunkQty = remainingSale
            chunkCost = chunkQty * currentBatch(3)
            currentBatch(2) = availableQty - chunkQty
            pos = foundIndex

            ' Remove then re-add remaining item
            fifoList.Remove foundIndex
            If pos >= 1 And pos <= fifoList.count Then
                fifoList.Add Item:=currentBatch, Before:=pos
            Else
                fifoList.Add Item:=currentBatch
            End If

            remainingSale = 0
        End If

        ' 3) Calculate profit and revenue for the chunk
        chunkRevenue = SaPrice * chunkQty
        chunkProfit = chunkRevenue - chunkCost

        ' 4) Update actual balance
        If dictBalance.Exists(LitemID) Then
            dictBalance(LitemID) = dictBalance(LitemID) - chunkQty
        Else
            dictBalance.Add LitemID, -chunkQty
        End If

        ' 5) Insert record for this chunk
        sqlChunk = _
          "INSERT INTO TblFifoStockLocal " & _
          "(InvID, InvType, InvTypeName, ItemCode, ItemName, " & _
           "PurchasedQty, SoldQty, ReturnPurchasedQty, ReturnSoldQty, ActualBalance, " & _
           "PurchasePrice, SalePrice, Profit, CostOfGoodsSold, TotalOfGoodsPurchased, TransactionDate) " & _
          "VALUES (" & _
            rst!InvID & ", " & _
            rst!InvType & ", '" & rst!InvTypeName & "', " & _
            LitemID & ", '" & ItemName & "', " & _
            "0, " & chunkQty & ", 0, 0, " & dictBalance(LitemID) & ", " & _
            currentBatch(3) & ", " & SaPrice & ", " & _
            Format(chunkProfit, "0.00") & ", " & _
            chunkCost & ", " & _
            Format$(chunkRevenue, "0.00") & ", #" & _
            Format$(InvDate, "mm\/dd\/yyyy") & "#);"

        db.Execute sqlChunk, dbFailOnError

        ' 6) If sale remains, find next batch
        If remainingSale > 0 Then
            foundIndex = 0
            For i = 1 To fifoList.count
                If fifoList(i)(0) = LitemID Then
                    foundIndex = i
                    Exit For
                End If
            Next i
        End If
    Loop

    ' **Do NOT** insert any total Qty INSERT here
    ' => All sale chunks were already inserted during the above loop


    Case 3  ' Purchase Returns
        remainingReturn = Qty
        TotalCost = 0

        ' Find first batch with balance to return
        foundIndex = 0
        For j = 1 To fifoList.count
            If fifoList(j)(0) = LitemID Then
                foundIndex = j
                Exit For
            End If
        Next j

        Do While remainingReturn > 0 And foundIndex > 0
            If foundIndex > fifoList.count Then Exit Do

            currentBatch = fifoList(foundIndex)
            availableQty = currentBatch(2)

            If availableQty <= remainingReturn Then
                TotalCost = TotalCost + availableQty * currentBatch(3)
                remainingReturn = remainingReturn - availableQty
                fifoList.Remove foundIndex

            Else
                TotalCost = TotalCost + remainingReturn * currentBatch(3)
                currentBatch(2) = availableQty - remainingReturn
                pos = foundIndex

                fifoList.Remove foundIndex
                If pos >= 1 And pos <= fifoList.count Then
                    fifoList.Add Item:=currentBatch, Before:=pos
                Else
                    fifoList.Add Item:=currentBatch
                End If

                remainingReturn = 0
            End If

            If remainingReturn > 0 Then
                foundIndex = 0
                For j = 1 To fifoList.count
                    If fifoList(j)(0) = LitemID Then
                        foundIndex = j
                        Exit For
                    End If
                Next j
            End If
        Loop

        If Qty <> 0 Then unitCost = TotalCost / Qty Else unitCost = 0
        If dictBalance.Exists(LitemID) Then
            dictBalance(LitemID) = dictBalance(LitemID) - Qty
        Else
            dictBalance.Add LitemID, -Qty
        End If

        SQL = "INSERT INTO TblFifoStockLocal " & _
              "(InvID, InvType, InvTypeName, ItemCode, ItemName, PurchasedQty, SoldQty, " & _
              "ReturnPurchasedQty, ReturnSoldQty, ActualBalance, PurchasePrice, SalePrice, " & _
              "Profit, CostOfGoodsSold, TotalOfGoodsPurchased, TransactionDate) " & _
              "VALUES (" & rst!InvID & ", " & rst!InvType & ", '" & rst!InvTypeName & "', " & _
               LitemID & ", '" & ItemName & "', 0, 0, " & Qty & ", 0, " & _
               dictBalance(LitemID) & ", " & unitCost & ", 0, " & -TotalCost & ", 0, 0, #" & _
               Format(InvDate, "mm\/dd\/yyyy") & "#);"
        db.Execute SQL, dbFailOnError
        ' ————————————

 
            
                
            Case 4 ' Sales Returns
                If dictBalance.Exists(LitemID) Then
                    dictBalance(LitemID) = dictBalance(LitemID) + Qty
                Else
                    dictBalance.Add LitemID, Qty
                End If
                Dim returnProfit As Double
                returnProfit = (PaPrice * Qty) - (SaPrice * Qty)
                CostOfGoodsSold = PaPrice * Qty
                TotalOfGoodsPurchased = SaPrice * Qty
                SQL = "INSERT INTO TblFifoStockLocal " & _
                        "(InvID, InvType, InvTypeName, ItemCode, ItemName, PurchasedQty, SoldQty, " & _
                        "ReturnPurchasedQty, ReturnSoldQty, ActualBalance, PurchasePrice, SalePrice, " & _
                        "Profit, CostOfGoodsSold, TotalOfGoodsPurchased, TransactionDate) " & _
                        "VALUES (" & rst!InvID & ", " & rst!InvType & ", '" & rst!InvTypeName & "', " & _
                        LitemID & ", '" & ItemName & "', 0, 0, 0, " & Qty & ", " & _
                        dictBalance(LitemID) & ", " & PaPrice & ", " & SaPrice & ", " & _
                        returnProfit & ", " & (-CostOfGoodsSold) & ", " & (-TotalOfGoodsPurchased) & ", #" & Format(InvDate, "mm/dd/yyyy") & "#);"
                db.Execute SQL, dbFailOnError
                
                ' ======= Here we add the return as a new batch in FIFO =======
                currentBatch = Array(LitemID, ItemName, Qty, PaPrice, InvDate, xInvIDs, xInvNo)
                fifoList.Add currentBatch
            End Select
        
        rst.MoveNext
    Loop
    
    rst.Close
    Set rst = Nothing
    Set db = Nothing
    
    
    '===========================
    ' Populate TblFifoRemaining from remaining list
    '===========================
    Dim batch As Variant
    For i = 1 To fifoList.count
        batch = fifoList(i)
'        sql = "INSERT INTO TblFifoRemaining (ItemCode, InvNo, ItemName, InvDate, RemainingQty, PurchasePrice, TotalCost) " & _
'          "VALUES (" & batch(0) & ", '" & batch(5) & "', '" & Replace(batch(1), "'", "''") & "', #" & Format(batch(4), "mm/dd/yyyy") & "#, " & _
'          batch(2) & ", " & batch(3) & ", " & (batch(2) * batch(3)) & ");"

'Debug.Print "Batch contents:"
'For j = LBound(batch) To UBound(batch)
'    Debug.Print "batch(" & j & ") = " & batch(j) & " (Type: " & TypeName(batch(j)) & ")"
'Next j
         SQL = "INSERT INTO TblFifoRemaining (ItemCode, InvID, InvNo, ItemName, InvDate, RemainingQty, PurchasePrice, TotalCost) " & _
          "VALUES (" & Nz(batch(0), 0) & ", '" & Replace(batch(5), "'", "''") & "', '" & Replace(batch(6), "'", "''") & "', '" & Replace(batch(1), "'", "''") & "', " & _
          "#" & Format(batch(4), "mm\/dd\/yyyy") & "#, " & Nz(batch(2), 0) & ", " & Nz(batch(3), 0) & ", " & (Nz(batch(2), 0) * Nz(batch(3), 0)) & ");"
'           Debug.Print sql
            CurrentDb.Execute SQL, dbFailOnError
    Next i
    
    
    '===========================
    ' After processing, check final balance for each item
    ' If less than zero, move all item transactions to TblFifoErrorQty
    '===========================
    Dim Key As Variant
    Dim rsError As DAO.Recordset
    Dim sqlError As String
    For Each Key In dictBalance.Keys
        If dictBalance(Key) < 0 Then
            sqlError = "SELECT TOP 1 * FROM TblFifoStockLocal WHERE ItemCode = " & Key & " AND ActualBalance < 0 ORDER BY TransactionDate ASC;"
            Set rsError = CurrentDb.OpenRecordset(sqlError, dbOpenDynaset)
            If Not rsError.EOF Then
                RecordFifoErrorQty CStr(rsError!InvID), CStr(rsError!ItemCode), rsError!ItemName, "Negative final balance"
            End If
            rsError.Close
            Set rsError = Nothing
        End If
    Next Key
    
    '===========================
    ' Call GenerateFifoSummary procedure to generate the report
    '===========================
    Call GenerateFifoSummary
    If ActiveMsgBox = False Then
        MsgBox "FIFO has been processed and profits calculated.", vbInformation
    End If
    Exit Function

HandleExit:
    Exit Function
    
HandleError:
    Debug.Print Err.Number & vbNewLine & Err.Description & vbNewLine & "From Public Function ProcessFIFO()"
    Resume HandleExit
End Function

' Helper function to set field property (Caption or Description)
Public Sub SetFieldProperty(fld As DAO.Field, propName As String, propValue As Variant)
    Dim prp As DAO.Property
    On Error Resume Next
    fld.Properties(propName) = propValue
    If Err.Number <> 0 Then
        Err.Clear
        Set prp = fld.CreateProperty(propName, dbText, propValue)
        fld.Properties.Append prp
    End If
    On Error GoTo 0
End Sub
' Sub procedure to record quantity errors in TblFifoErrorQty table
Public Sub RecordFifoErrorQty(InvID As String, ItemID As String, ItemName As String, Remarks As String)
    'On Error GoTo Err_Handler
    Dim db As DAO.Database
    Dim SQL As String
    Dim tdf As DAO.TableDef
    Dim tableExists As Boolean
    
    Set db = CurrentDb()
    
    tableExists = False
    For Each tdf In db.TableDefs
        If tdf.Name = "TblFifoErrorQty" Then
            tableExists = True
            Exit For
        End If
    Next tdf
    
    If Not tableExists Then
        SQL = "CREATE TABLE TblFifoErrorQty (" & _
              "ID AUTOINCREMENT PRIMARY KEY, " & _
              "ItemCode LONG, " & _
              "ItemName TEXT(100), " & _
              "InvID TEXT(20), " & _
              "Remarks TEXT(200)" & _
              ");"
        db.Execute SQL, dbFailOnError
        db.Close
        Set db = Nothing
    End If
    
    Dim rst As DAO.Recordset
    Set db = CurrentDb
    Set rst = db.OpenRecordset("TblFifoErrorQty", dbOpenDynaset)
    With rst
        .AddNew
        !ItemCode = ItemID
        !ItemName = ItemName
        !InvID = InvID
        !Remarks = Remarks
        .Update
        .Close
    End With
    Set rst = Nothing
    db.Close
    Set db = Nothing
    Exit Sub
'Err_Handler:
'    MsgBox "Error in recording quantity: " & Err.Description
End Sub


' Sub procedure to generate a summary report in TblFifoSummary table for each item
Public Sub GenerateFifoSummary()
'On Error GoTo HandleError

    Dim db As DAO.Database
    Dim tdf As DAO.TableDef
    Dim tableExists As Boolean
    Dim SQL As String

    Set db = CurrentDb()

    '===========================
    ' Create TblFifoSummary table if it doesn't exist
    ' Field names in English with Arabic Caption and Description
    '===========================
    tableExists = False
    For Each tdf In db.TableDefs
        If tdf.Name = "TblFifoSummary" Then
            tableExists = True
            Exit For
        End If
    Next tdf

    If Not tableExists Then
        SQL = "CREATE TABLE TblFifoSummary (" & _
              "ID AUTOINCREMENT PRIMARY KEY, " & _
              "ItemCode LONG, " & _
              "ItemName TEXT(100), " & _
              "PurchasedQty Double, " & _
              "SoldQty Double, " & _
              "ReturnPurchasedQty Double, " & _
              "ReturnSoldQty Double, " & _
              "ActualBalance Double, " & _
              "TotalProfit DOUBLE, " & _
              "TotalSaleRevenue DOUBLE, " & _
              "TotalPurchasedRevenue DOUBLE, " & _
              "ProfitPercentage DOUBLE" & _
              ");"
        db.Execute SQL, dbFailOnError
        db.TableDefs.Refresh
        ' Add Caption and Description for each field
        Set tdf = db.TableDefs("TblFifoSummary")
        Dim fld As DAO.Field
        For Each fld In tdf.Fields
            Select Case fld.Name
                Case "ItemCode"
                    SetFieldProperty fld, "Caption", "Item Number"
                    SetFieldProperty fld, "Description", "Item number as in source"
                Case "ItemName"
                    SetFieldProperty fld, "Caption", "Item Name"
                    SetFieldProperty fld, "Description", "Item name"
                Case "PurchasedQty"
                    SetFieldProperty fld, "Caption", "Purchased Quantity"
                    SetFieldProperty fld, "Description", "Total purchased quantity for this item"
                Case "SoldQty"
                    SetFieldProperty fld, "Caption", "Sold Quantity"
                    SetFieldProperty fld, "Description", "Total sold quantity for this item"
                Case "ActualBalance"
                    SetFieldProperty fld, "Caption", "Actual Balance"
                    SetFieldProperty fld, "Description", "Actual balance after all operations"
                Case "TotalProfit"
                    SetFieldProperty fld, "Caption", "Total Profit"
                    SetFieldProperty fld, "Description", "Total profit achieved for this item"
                Case "TotalSaleRevenue"
                    SetFieldProperty fld, "Caption", "Total Sales Revenue"
                    SetFieldProperty fld, "Description", "Total sales revenue for this item"
                Case "TotalPurchasedRevenue"
                    SetFieldProperty fld, "Caption", "Total Purchases Revenue"
                    SetFieldProperty fld, "Description", "Total purchases revenue for this item"
                Case "ProfitPercentage"
                    SetFieldProperty fld, "Caption", "Profit Percentage"
                    SetFieldProperty fld, "Description", "Profit percentage (Profit/Sales Revenue *100)"
                Case "ReturnPurchasedQty"
                    SetFieldProperty fld, "Caption", "Purchase Returns Quantity"
                    SetFieldProperty fld, "Description", "Total returned quantity from purchases"
                Case "ReturnSoldQty"
                    SetFieldProperty fld, "Caption", "Sales Returns Quantity"
                    SetFieldProperty fld, "Description", "Total returned quantity from sales"
            End Select
        Next fld

    Else
        ' Clear previous report data
        SQL = "DELETE FROM TblFifoSummary;"
        db.Execute SQL, dbFailOnError
    End If

    ' Aggregate data for each item from TblFifoStockLocal
    SQL = "INSERT INTO TblFifoSummary ( ItemCode, ItemName, PurchasedQty, SoldQty, ReturnPurchasedQty, ReturnSoldQty, ActualBalance, " & _
            "TotalProfit, TotalSaleRevenue, ProfitPercentage, TotalPurchasedRevenue ) " & _
            "SELECT TblFifoStockLocal.ItemCode, TblFifoStockLocal.ItemName, Sum(TblFifoStockLocal.PurchasedQty) AS SumPurchased, " & _
            "Sum(TblFifoStockLocal.SoldQty) AS SumSold, Sum(TblFifoStockLocal.ReturnPurchasedQty) AS SumReturnPurchasedQty, " & _
            "Sum(TblFifoStockLocal.ReturnSoldQty) AS SumReturnSoldQty, (Sum([PurchasedQty])-Sum([SoldQty])-Sum([ReturnPurchasedQty])+Sum([ReturnSoldQty])) AS SumActual, " & _
            "Sum(TblFifoStockLocal.Profit) AS SumProfit, Sum(IIf(SalePrice<>0,(SalePrice*SoldQty)-(SalePrice*ReturnSoldQty),0)) AS SumSaleRevenue, " & _
            "IIf(Sum(IIf(SalePrice<>0,(SalePrice*SoldQty)-(SalePrice*ReturnSoldQty),0))=0,0,(Sum(Profit)/Sum(IIf(SalePrice<>0,(SalePrice*SoldQty)-(SalePrice*ReturnSoldQty),0)))*100) AS SumProfitPerc, " & _
            "Sum(IIf([PurchasePrice]<>0,([PurchasePrice]*[PurchasedQty])-([PurchasePrice]*[ReturnPurchasedQty]),0)) AS SumPurchasedRevenue " & _
            "From TblFifoStockLocal " & _
                "GROUP BY TblFifoStockLocal.ItemCode, TblFifoStockLocal.ItemName;"
    db.Execute SQL, dbFailOnError




    '========================================================
    'print report of error from table TblFifoSummary (START)
    '========================================================

    tableExists = False
        For Each tdf In db.TableDefs
            If tdf.Name = "TblFifoErrorQty" Then
                tableExists = True
                Exit For
            End If
        Next tdf

        If Not tableExists Then
        SQL = "CREATE TABLE TblFifoErrorQty (" & _
              "ID AUTOINCREMENT PRIMARY KEY, " & _
              "ItemCode LONG, " & _
              "ItemName TEXT(100), " & _
              "InvID TEXT(20), " & _
              "Remarks TEXT(200)" & _
              ");"
        db.Execute SQL, dbFailOnError
        db.Close
        Set db = Nothing
        End If

    Dim Rpt As Report
    Dim strFind As String
    Dim PDFFileName As String
    Dim PDFReportName As String

If Nz(DCount("*", "[TblFifoErrorQty]"), 0) <> 0 Then


    PDFReportName = "Rep_Error_Qty_FIFO"
    DoCmd.OpenReport PDFReportName, acViewPreview, , strFind, acHidden
    Set Rpt = Reports(PDFReportName)
    PDFFileName = "(Summary Report) of bills errors and quantities " & Format(Now, "dd-mm-yyyy_hhmmss")
    IsErrorMsg = True
    SavePDFPatchName PDFReportName, PDFFileName
    DoCmd.Close acReport, PDFReportName
    IsErrorMsg = False
    
    
    PDFReportName = "Rep_Error_Qty_FIFO2"
    DoCmd.OpenReport PDFReportName, acViewPreview, , strFind, acHidden
    Set Rpt = Reports(PDFReportName)
    PDFFileName = "(Detailed Report) of bills errors and quantities " & Format(Now, "dd-mm-yyyy_hhmmss")
    IsErrorMsg = True
    SavePDFPatchName PDFReportName, PDFFileName
    DoCmd.Close acReport, PDFReportName
    IsErrorMsg = False
    
    
End If

    '========================================================
    'print report of error from table TblFifoSummary (END)
    '========================================================


    Set db = Nothing
    Exit Sub


HandleExit:
    Exit Sub

HandleError:
    Select Case Err.Number
        Case 0
            Exit Sub
        Case Else
            Debug.Print Err.Number & vbNewLine & Err.Description & vbNewLine & "From Public Sub GenerateFifoSummary()"
    End Select

    Resume HandleExit
End Sub

Public Function SavePDFPatchName(ByVal PDFReportName As String, ByVal PDFFileName As String) As Boolean

    If IsNull(PDFReportName) Or PDFReportName = "" Then
        MsgBox "There is an unknown error: Report name may be empty", vbCritical
        Exit Function
    End If
    If IsNull(PDFFileName) Or PDFFileName = "" Then
        MsgBox "There is an unknown error: Form name may be empty", vbCritical
        Exit Function
    End If
    ' Format filename
    PDFFileName = Replace(PDFFileName, "/", "-")
    PDFFileName = Replace(PDFFileName, "\", "-")
    PDFFileName = Replace(PDFFileName, "#", "_")
    ' Create final file path
    Dim fullPath As String
    Dim SaveToLocation As String

   
    SaveToLocation = Environ("USERPROFILE") & "\Desktop\Report from System"
    fullPath = SaveToLocation & "\" & PDFFileName & ".pdf"
    
    Dim fso As New FileSystemObject
'    Dim fso As Object
    ' Check if folder exists and create it
    If Not fso.FolderExists(SaveToLocation) Then
        fso.CreateFolder (SaveToLocation)
    End If

    ' Export report to PDF file
    DoCmd.OutputTo acOutputReport, PDFReportName, acFormatPDF, fullPath, True
    
    SavePDFPatchName = True
    If IsErrorMsg Then
        MsgBox "The PDF file was successfully exported" & vbNewLine & "" & fullPath, vbCritical, "Error"
    Else
        MsgBox "The PDF file was successfully exported" & vbNewLine & "" & fullPath, vbInformation
    End If
    Exit Function
    
End Function

 

مشكلتى فى Case 2 
وهذا هو بعد فصله من الكود للتوضيح 
  

   Case 2  ' ====== Sales ======
    
    remainingSale = Qty

    ' 1) Find first batch in FIFO for the item
    foundIndex = 0
    For i = 1 To fifoList.count
        If fifoList(i)(0) = LitemID Then
            foundIndex = i
            Exit For
        End If
    Next i

    ' 2) Repeat until full sale quantity is processed
    Do While remainingSale > 0 And foundIndex > 0
        ' If list size changes making index out of range, exit
        If foundIndex > fifoList.count Then Exit Do

        currentBatch = fifoList(foundIndex)
        availableQty = currentBatch(2)

        If availableQty <= remainingSale Then
            ' Consume entire batch
            chunkQty = availableQty
            chunkCost = chunkQty * currentBatch(3)
            remainingSale = remainingSale - chunkQty
            fifoList.Remove foundIndex

        Else
            ' Consume part of the batch
            chunkQty = remainingSale
            chunkCost = chunkQty * currentBatch(3)
            currentBatch(2) = availableQty - chunkQty
            pos = foundIndex

            ' Remove then re-add remaining item
            fifoList.Remove foundIndex
            If pos >= 1 And pos <= fifoList.count Then
                fifoList.Add Item:=currentBatch, Before:=pos
            Else
                fifoList.Add Item:=currentBatch
            End If

            remainingSale = 0
        End If

        ' 3) Calculate profit and revenue for the chunk
        chunkRevenue = SaPrice * chunkQty
        chunkProfit = chunkRevenue - chunkCost

        ' 4) Update actual balance
        If dictBalance.Exists(LitemID) Then
            dictBalance(LitemID) = dictBalance(LitemID) - chunkQty
        Else
            dictBalance.Add LitemID, -chunkQty
        End If

        ' 5) Insert record for this chunk
        sqlChunk = _
          "INSERT INTO TblFifoStockLocal " & _
          "(InvID, InvType, InvTypeName, ItemCode, ItemName, " & _
           "PurchasedQty, SoldQty, ReturnPurchasedQty, ReturnSoldQty, ActualBalance, " & _
           "PurchasePrice, SalePrice, Profit, CostOfGoodsSold, TotalOfGoodsPurchased, TransactionDate) " & _
          "VALUES (" & _
            rst!InvID & ", " & _
            rst!InvType & ", '" & rst!InvTypeName & "', " & _
            LitemID & ", '" & ItemName & "', " & _
            "0, " & chunkQty & ", 0, 0, " & dictBalance(LitemID) & ", " & _
            currentBatch(3) & ", " & SaPrice & ", " & _
            Format(chunkProfit, "0.00") & ", " & _
            chunkCost & ", " & _
            Format$(chunkRevenue, "0.00") & ", #" & _
            Format$(InvDate, "mm\/dd\/yyyy") & "#);"

        db.Execute sqlChunk, dbFailOnError

        ' 6) If sale remains, find next batch
        If remainingSale > 0 Then
            foundIndex = 0
            For i = 1 To fifoList.count
                If fifoList(i)(0) = LitemID Then
                    foundIndex = i
                    Exit For
                End If
            Next i
        End If
    Loop

 

ابوخليل

ابوخليل

قام بنشر
قام بنشر


بالنسبة لي لايمكنني العثور على الخلل او الثغرة الا بالتتبع من خلال المثال وادواته

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

..................................................

 انظمة المخازن عموما يستخدم فيها اربعة طرق تقريبا :

تدور كلها حول كيفية التعامل : مع الضريبة ، وعند تضخم الاسعار  ، وتكلفة التخزين

1- فيفو ، 2- ليفو ، 3- المتوسطات ، 4- الانتقاء والتحديد ( لكل نوع من هذه ميزاته وعيوبه)

الانتقاء والتحديد : خاص بالاصناف النادرة والثمينة ، وهذا لايهمنا

الليفو : هو عكس الفيفو تماما ما جاء آخرا يخرج اولا .. وهذا ايضا لا يهمنا

المتوسطات : وهو التحكم بمرونة الاسعار .. بغض النظر عن الداخل والخارج ...

الفيفو : وهو الداخل اولا يخرج اولا .. مع تثبيت الاسعار  .. يتميز بدقة المخرجات ( الارباح والخسائر ) .. وتتأكد الحاجة اليه في متاجر الخضروات والفواكه والصيدليات وجميع المشاريع التي صلاحية الاصناف فيها لها وقت محدد .

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

..............................................................

نأتي للفيفو :

وعندي ملاحظة اعتقد انها مهمة لضبط العملية وتسيير العمليات الحسابية بصورة سلسة ، والاستغناء عن الكثير من الاكواد والوحدات النمطية :

حسب تصوري فيما لو قمت بتصميم برنامجي من الصفر :

بما ان شراء الصنف يتم على فترات متباعدة وتسجل بتاريخ محدد وسعر محدد .. ودعونا نسميها دفعات شرائية .. وتأخذ مكانها من المخزن

يجب ايجاد (حقل) علامة او رمز او رقم او اي شيء ولا مشاحة في التسمية والافضل كونه رقما .. يشير الى الدفعة الشرائية للصنف وليكن _تجاوزا _ تسميته برقم الرف في المخزن

الرقم هذا هو الفاصل بين دفعة وأخرى وعليه يتم احتساب الارصدة واحتساب العمليات الداخلة والخارجة ومخرجاتها

اذا كان الرقم متسلسلا فسوف يسهل الانتقال آليا الى الدفعة التالية .. 

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

وحيث انني لم اطلع على العمل  فآمل اعتبار ما كتبته اعلاه للفائدة العامة .

 

  • Thanks 1
عمر ضاحى

عمر ضاحى

قام بنشر
  • الكاتب
قام بنشر
21 ساعات مضت, ابوخليل said:


بالنسبة لي لايمكنني العثور على الخلل او الثغرة الا بالتتبع من خلال المثال وادواته

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

..................................................

 انظمة المخازن عموما يستخدم فيها اربعة طرق تقريبا :

تدور كلها حول كيفية التعامل : مع الضريبة ، وعند تضخم الاسعار  ، وتكلفة التخزين

1- فيفو ، 2- ليفو ، 3- المتوسطات ، 4- الانتقاء والتحديد ( لكل نوع من هذه ميزاته وعيوبه)

الانتقاء والتحديد : خاص بالاصناف النادرة والثمينة ، وهذا لايهمنا

الليفو : هو عكس الفيفو تماما ما جاء آخرا يخرج اولا .. وهذا ايضا لا يهمنا

المتوسطات : وهو التحكم بمرونة الاسعار .. بغض النظر عن الداخل والخارج ...

الفيفو : وهو الداخل اولا يخرج اولا .. مع تثبيت الاسعار  .. يتميز بدقة المخرجات ( الارباح والخسائر ) .. وتتأكد الحاجة اليه في متاجر الخضروات والفواكه والصيدليات وجميع المشاريع التي صلاحية الاصناف فيها لها وقت محدد .

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

..............................................................

نأتي للفيفو :

وعندي ملاحظة اعتقد انها مهمة لضبط العملية وتسيير العمليات الحسابية بصورة سلسة ، والاستغناء عن الكثير من الاكواد والوحدات النمطية :

حسب تصوري فيما لو قمت بتصميم برنامجي من الصفر :

بما ان شراء الصنف يتم على فترات متباعدة وتسجل بتاريخ محدد وسعر محدد .. ودعونا نسميها دفعات شرائية .. وتأخذ مكانها من المخزن

يجب ايجاد (حقل) علامة او رمز او رقم او اي شيء ولا مشاحة في التسمية والافضل كونه رقما .. يشير الى الدفعة الشرائية للصنف وليكن _تجاوزا _ تسميته برقم الرف في المخزن

الرقم هذا هو الفاصل بين دفعة وأخرى وعليه يتم احتساب الارصدة واحتساب العمليات الداخلة والخارجة ومخرجاتها

اذا كان الرقم متسلسلا فسوف يسهل الانتقال آليا الى الدفعة التالية .. 

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

وحيث انني لم اطلع على العمل  فآمل اعتبار ما كتبته اعلاه للفائدة العامة .

 

اعتذر منك استاذي الجليل 

على التأخر فى الرد

لكن الفيفو اصله والله اعلم لغرض التعامل مع تقلبات الاسعار للشراء والتضخم 

 

وبالنسبه لموضوعي ف انا شبه وضعت ايدي على الحل وعرفت اين الخلل

 

  • Like 1
ابوخليل

ابوخليل

قام بنشر
قام بنشر
43 دقائق مضت, عمر ضاحى said:

لكن الفيفو اصله والله اعلم لغرض التعامل مع تقلبات الاسعار للشراء والتضخم 


نعم كما تفضلت .. هذا جزء أساسي .. وأنا ذكرت ذلك .. والجزء الآخر هو إدارة التخزين لمراعاة نهاية الصلاحية الذي لا يقل أهمية

  • Like 2
jjafferr

jjafferr

قام بنشر
قام بنشر
1 ساعه مضت, ابوخليل said:

والجزء الآخر هو إدارة التخزين لمراعاة نهاية الصلاحية الذي لا يقل أهمية

FIFO = First in, First Out

المادة الداخلة في البداية ، تخرج في البداية

 

تماما كما تفضلت به اخوي ابوخليل 🙂

  • Like 1
  • Thanks 1
ابوخليل

ابوخليل

قام بنشر
قام بنشر
58 دقائق مضت, jjafferr said:

FIFO = First in, First Out

المادة الداخلة في البداية ، تخرج في البداية

تماما كما تفضلت به اخوي ابوخليل 🙂

اخوي جعفر .. ما دمت دخلت على الخط

لو تتكرم بفتح موضوع جديد لمناقشة التالي :

البحث عن أسهل طريقة ( وبأسهل الادوات المساعدة ) لتطبيق الانتقال بين دفعات الشراء آليا من دون تدخل المستخدم  ( ما يدخل اولا يخرج أولا )

نريد في فاتورة البيع او تفاصيلها ان يظهر الصنف فقط .. اما مسألة اخراج الأول ثم الذي يليه يتكفل به اكسس من دون تدخل يدوي .

هذه النقطة  غالبا لا يتم التطرق لها  أو لنقل لم تعطى حقها من الشرح والتفصيل _ فهي بحاجة الى التطبيق الاحترافي الصحيح

 

  • Thanks 1
jjafferr

jjafferr

قام بنشر
قام بنشر
10 دقائق مضت, ابوخليل said:

فتح موضوع جديد لمناقشة التالي :

البحث عن أسهل طريقة ( وبأسهل الادوات المساعدة ) لتطبيق الانتقال بين دفعات الشراء آليا من دون تدخل المستخدم  ( ما يدخل اولا يخرج أولا )

على بركة الله 

 

 

 

فيه موضوع عمله اخونا ابو جودي ، ما ادري مدى ارتباطة بالموضوع الذي تريد عمله :

 

  • Thanks 3
عمر ضاحى

عمر ضاحى

قام بنشر
  • الكاتب
قام بنشر
منذ ساعه, jjafferr said:

على بركة الله 

 

 

 

فيه موضوع عمله اخونا ابو جودي ، ما ادري مدى ارتباطة بالموضوع الذي تريد عمله :

 

يا ريت 🌹🌹🌹

ناقل

ناقل

قام بنشر
قام بنشر
7 ساعات مضت, عمر ضاحى said:

وبالنسبه لموضوعي ف انا شبه وضعت ايدي على الحل وعرفت اين الخلل

 

ايش الخلل .... وبدون مبالغة على مدى يومين وابا ابحث عن ثغرة ... لم اجد ...

ممكن شرح الخلل اين؟؟؟

  • Like 1
عمر ضاحى

عمر ضاحى

قام بنشر
  • الكاتب
قام بنشر
الان, ناقل said:

ايش الخلل .... وبدون مبالغة على مدى يومين وابا ابحث عن ثغرة ... لم اجد ...

ممكن شرح الخلل اين؟؟؟

الخلل ان هناك سجلات مفقوده (لاحظه فى الصورة هنا)

 

في 25‏/5‏/2025 at 09:09, عمر ضاحى said:

PEpJIB.png

من المفترض ان الكود يدور على جميع السجلات فى عمليات البيع 
لكنه لا يسجل عملية البيع لبعض الاصناف (مجنون شكله ^_^)

لاحظ هنا حسب الاستعلام عن الكميات بالطريقة المباشرة فى الاستعلامات اعطاني ان كمية البيع هي 190 لكن فى الكود اعطاني 112 اين باقي الكمية ؟

هذا هو الخلل

Foksh

Foksh

قام بنشر
قام بنشر
9 دقائق مضت, عمر ضاحى said:

الخلل ان هناك سجلات مفقوده (لاحظه فى الصورة هنا)

 

من المفترض ان الكود يدور على جميع السجلات فى عمليات البيع 
لكنه لا يسجل عملية البيع لبعض الاصناف (مجنون شكله ^_^)

لاحظ هنا حسب الاستعلام عن الكميات بالطريقة المباشرة فى الاستعلامات اعطاني ان كمية البيع هي 190 لكن فى الكود اعطاني 112 اين باقي الكمية ؟

هذا هو الخلل

تضدق أخي عمر أني كنت أبحث في اتجاه آخر ( عدد الفواتير ) :biggrin:

لاحظ آخر وقوفي عند هذا التعديل :- 


Public Function ProcessFIFO()
    On Error GoTo HandleError

    Dim db As DAO.Database
    Dim tdf As DAO.TableDef
    Dim tableExists As Boolean
    Dim SQL As String
    Dim rst As DAO.Recordset
    Dim i As Long
    Dim currentBatch As Variant
    Dim newBatch As Variant
    Dim remainingSale As Double
    Dim deductQty As Double
    Dim profit As Double
    Dim salePrice As Double
    Dim purchasePrice As Double
    Dim salesInvoiceCount As Long
    Dim lastSalesInvID As String
    Dim specificItemSalesCount As Long
    Dim targetItemCode As Long
    
    specificItemSalesCount = 0
    targetItemCode = 19
    salesInvoiceCount = 0
    lastSalesInvID = ""
    
    Set db = CurrentDb()
    
    tableExists = False
    For Each tdf In db.TableDefs
        If tdf.Name = "TblFifoStockLocal" Then
            tableExists = True
            Exit For
        End If
    Next tdf
    
    If Not tableExists Then
        SQL = "CREATE TABLE TblFifoStockLocal (" & _
              "ID AUTOINCREMENT PRIMARY KEY, " & _
              "InvID TEXT(50), " & _
              "InvType LONG, " & _
              "InvTypeName TEXT(50), " & _
              "ItemCode LONG, " & _
              "ItemName TEXT(100), " & _
              "PurchasedQty Double, " & _
              "SoldQty Double, " & _
              "ReturnPurchasedQty Double, " & _
              "ReturnSoldQty Double, " & _
              "ActualBalance Double, " & _
              "PurchasePrice DOUBLE, " & _
              "SalePrice DOUBLE, " & _
              "Profit DOUBLE, " & _
              "CostOfGoodsSold DOUBLE, " & _
              "TotalOfGoodsPurchased DOUBLE, " & _
              "TransactionDate DATETIME);"
        db.Execute SQL, dbFailOnError
        db.TableDefs.Refresh
        
        Set tdf = db.TableDefs("TblFifoStockLocal")
        With tdf.Fields("ID")
            .Properties("Caption") = "SN"
        End With
        With tdf.Fields("InvID")
            .Properties("Caption") = "معرف الفاتورة"
        End With
        With tdf.Fields("InvType")
            .Properties("Caption") = "نوع الفاتورة"
        End With
        With tdf.Fields("InvTypeName")
            .Properties("Caption") = "اسم نوع الفاتورة"
        End With
        With tdf.Fields("ItemCode")
            .Properties("Caption") = "رمز الصنف"
        End With
        With tdf.Fields("ItemName")
            .Properties("Caption") = "اسم الصنف"
        End With
        With tdf.Fields("PurchasedQty")
            .Properties("Caption") = "الكمية المشتراة"
        End With
        With tdf.Fields("SoldQty")
            .Properties("Caption") = "الكمية المباعة"
        End With
        With tdf.Fields("ReturnPurchasedQty")
            .Properties("Caption") = "كمية مرتجع المشتريات"
        End With
        With tdf.Fields("ReturnSoldQty")
            .Properties("Caption") = "كمية مرتجع المبيعات"
        End With
        With tdf.Fields("ActualBalance")
            .Properties("Caption") = "الرصيد الفعلي"
        End With
        With tdf.Fields("PurchasePrice")
            .Properties("Caption") = "سعر الشراء"
        End With
        With tdf.Fields("SalePrice")
            .Properties("Caption") = "سعر البيع"
        End With
        With tdf.Fields("Profit")
            .Properties("Caption") = "الربح"
        End With
        With tdf.Fields("CostOfGoodsSold")
            .Properties("Caption") = "تكلفة البضاعة المباعة"
        End With
        With tdf.Fields("TotalOfGoodsPurchased")
            .Properties("Caption") = "إجمالي البضاعة المشتراة"
        End With
        With tdf.Fields("TransactionDate")
            .Properties("Caption") = "تاريخ العملية"
        End With
    Else
        db.Execute "DELETE FROM TblFifoStockLocal;", dbFailOnError
    End If
    tableExists = False
    For Each tdf In db.TableDefs
        If tdf.Name = "TblFifoRemaining" Then
            tableExists = True
            Exit For
        End If
    Next tdf
    
    If Not tableExists Then
        SQL = "CREATE TABLE TblFifoRemaining (" & _
              "ID AUTOINCREMENT PRIMARY KEY, " & _
              "ItemCode LONG, " & _
              "InvID DOUBLE, " & _
              "InvNo TEXT(50), " & _
              "ItemName TEXT(100), " & _
              "InvDate DATETIME, " & _
              "RemainingQty Double, " & _
              "PurchasePrice DOUBLE, " & _
              "TotalCost DOUBLE);"
        db.Execute SQL, dbFailOnError
        db.TableDefs.Refresh
        
        Set tdf = db.TableDefs("TblFifoRemaining")
        With tdf.Fields("ID")
            .Properties("Caption") = "SN"
        End With
        With tdf.Fields("ItemCode")
            .Properties("Caption") = "رمز الصنف"
        End With
        With tdf.Fields("InvID")
            .Properties("Caption") = "معرف الفاتورة"
        End With
        With tdf.Fields("InvNo")
            .Properties("Caption") = "رقم الفاتورة"
        End With
        With tdf.Fields("ItemName")
            .Properties("Caption") = "اسم الصنف"
        End With
        With tdf.Fields("InvDate")
            .Properties("Caption") = "تاريخ الفاتورة"
        End With
        With tdf.Fields("RemainingQty")
            .Properties("Caption") = "الكمية المتبقية"
        End With
        With tdf.Fields("PurchasePrice")
            .Properties("Caption") = "سعر الشراء"
        End With
        With tdf.Fields("TotalCost")
            .Properties("Caption") = "التكلفة الإجمالية"
        End With
    Else
        db.Execute "DELETE FROM TblFifoRemaining;", dbFailOnError
    End If
    SQL = "SELECT TblInvHead.InvID, TblInvHead.InvDate, TblInvHead.InvNo, " & _
          "TblInvHead.InvType, TblInvType.InvTypeName, TblInvDetails.ID, " & _
          "TblInvDetails.LItemID, TblItems.ItemName, " & _
          "TblInvDetails.Qty, TblInvDetails.PaPrice, TblInvDetails.SaPrice " & _
          "FROM TblInvType INNER JOIN (TblInvHead INNER JOIN " & _
          "(TblItems INNER JOIN TblInvDetails ON TblItems.ItemCode = TblInvDetails.LItemID) " & _
          "ON TblInvHead.InvID = TblInvDetails.LInvID) " & _
          "ON TblInvType.InvTypeID = TblInvHead.InvType " & _
          "ORDER BY TblInvHead.InvDate, TblInvHead.InvType, TblInvDetails.LItemID;"
    
    Set rst = db.OpenRecordset(SQL, dbOpenDynaset)
    
    Dim fifoList As New Collection
    Dim dictBalance As Object
    Set dictBalance = CreateObject("Scripting.Dictionary")
    
    Do While Not rst.EOF
        If Not IsNull(rst!Qty) And rst!Qty > 0 Then
            Select Case rst!InvType
                Case 1
                    If Not IsNull(rst!LitemID) Then
                        newBatch = Array(rst!LitemID, rst!ItemName, rst!Qty, rst!PaPrice, rst!InvDate, rst!InvID, rst!InvNo)
                        fifoList.Add newBatch
                        
                        If Not dictBalance.Exists(rst!LitemID) Then
                            dictBalance.Add rst!LitemID, 0
                        End If
                        dictBalance(rst!LitemID) = dictBalance(rst!LitemID) + rst!Qty
                        
                        db.Execute "INSERT INTO TblFifoStockLocal (InvID,InvType,InvTypeName,ItemCode,ItemName," & _
                                  "PurchasedQty,ActualBalance,PurchasePrice,TransactionDate) VALUES ('" & _
                                  rst!InvID & "',1,'مشتريات'," & rst!LitemID & ",'" & _
                                  Replace(rst!ItemName, "'", "''") & "'," & rst!Qty & "," & _
                                  dictBalance(rst!LitemID) & "," & rst!PaPrice & ",#" & _
                                  Format(rst!InvDate, "mm/dd/yyyy") & "#)", dbFailOnError
                    End If
                Case 2
                    If lastSalesInvID <> rst!InvID Then
                        salesInvoiceCount = salesInvoiceCount + 1
                        lastSalesInvID = rst!InvID
                    End If
                    remainingSale = rst!Qty
                    
                    For i = 1 To fifoList.Count
                        If fifoList(i)(0) = rst!LitemID Then
                            currentBatch = fifoList(i)
                            
                            If currentBatch(2) > 0 Then
                                deductQty = IIf(currentBatch(2) >= remainingSale, remainingSale, currentBatch(2))
                                
                                salePrice = Nz(rst!SaPrice, 0)
                                purchasePrice = Nz(currentBatch(3), 0)
                                profit = (salePrice - purchasePrice) * deductQty
                                
                                currentBatch(2) = currentBatch(2) - deductQty
                                
                                If Not dictBalance.Exists(rst!LitemID) Then
                                    dictBalance.Add rst!LitemID, 0
                                End If
                                dictBalance(rst!LitemID) = dictBalance(rst!LitemID) - deductQty
                            
                                db.Execute "INSERT INTO TblFifoStockLocal (InvID,InvType,InvTypeName,ItemCode," & _
                                          "ItemName,SoldQty,ActualBalance,PurchasePrice,SalePrice,Profit," & _
                                          "TransactionDate) VALUES ('" & rst!InvID & "',2,'مبيعات'," & _
                                          rst!LitemID & ",'" & Replace(rst!ItemName, "'", "''") & "'," & _
                                          deductQty & "," & dictBalance(rst!LitemID) & "," & _
                                          purchasePrice & "," & salePrice & "," & profit & ",#" & _
                                          Format(rst!InvDate, "mm/dd/yyyy") & "#)", dbFailOnError
                            
                                remainingSale = remainingSale - deductQty
                                
                                If remainingSale = 0 Then Exit For
                            End If
                        End If
                    Next i
                Case 3
                    If Not dictBalance.Exists(rst!LitemID) Then
                        dictBalance.Add rst!LitemID, 0
                    End If
                    dictBalance(rst!LitemID) = dictBalance(rst!LitemID) - rst!Qty
                    
                    db.Execute "INSERT INTO TblFifoStockLocal (InvID,InvType,InvTypeName,ItemCode,ItemName," & _
                              "ReturnPurchasedQty,ActualBalance,PurchasePrice,TransactionDate) VALUES ('" & _
                              rst!InvID & "',3,'مرتجع مشتريات'," & rst!LitemID & ",'" & _
                              Replace(rst!ItemName, "'", "''") & "'," & rst!Qty & "," & _
                              dictBalance(rst!LitemID) & "," & rst!PaPrice & ",#" & _
                              Format(rst!InvDate, "mm/dd/yyyy") & "#)", dbFailOnError
                
                Case 4
                    If Not dictBalance.Exists(rst!LitemID) Then
                        dictBalance.Add rst!LitemID, 0
                    End If
                    dictBalance(rst!LitemID) = dictBalance(rst!LitemID) + rst!Qty
                    
                    db.Execute "INSERT INTO TblFifoStockLocal (InvID,InvType,InvTypeName,ItemCode,ItemName," & _
                              "ReturnSoldQty,ActualBalance,SalePrice,TransactionDate) VALUES ('" & _
                              rst!InvID & "',4,'مرتجع مبيعات'," & rst!LitemID & ",'" & _
                              Replace(rst!ItemName, "'", "''") & "'," & rst!Qty & "," & _
                              dictBalance(rst!LitemID) & "," & rst!SaPrice & ",#" & _
                              Format(rst!InvDate, "mm/dd/yyyy") & "#)", dbFailOnError
            End Select
        End If
        rst.MoveNext
    Loop
    
    If fifoList.Count > 0 Then
        
        Dim insertCount As Long
        insertCount = 0
        
        For i = 1 To fifoList.Count
            currentBatch = fifoList(i)
            If IsArray(currentBatch) Then
                If IsNumeric(currentBatch(2)) Then
                    If CDbl(currentBatch(2)) > 0 Then
                        db.Execute "INSERT INTO TblFifoRemaining (ItemCode,InvID,InvNo,ItemName,InvDate," & _
                                  "RemainingQty,PurchasePrice,TotalCost) VALUES (" & _
                                  currentBatch(0) & "," & currentBatch(5) & ",'" & currentBatch(6) & "','" & _
                                  Replace(currentBatch(1), "'", "''") & "',#" & Format(currentBatch(4), "mm/dd/yyyy") & "#," & _
                                  currentBatch(2) & "," & currentBatch(3) & "," & (currentBatch(2) * currentBatch(3)) & ")", dbFailOnError
                        insertCount = insertCount + 1
                    End If
                End If
            End If
        Next i
        
    End If
    
    MsgBox "إجمالي عدد فواتير المبيعات: " & salesInvoiceCount, vbInformation + vbMsgBoxRight, ""
    
    rst.Close
    Set rst = Nothing
    Set db = Nothing
    Exit Function
    
HandleError:
    MsgBox "حدث خطأ: " & Err.Description, vbCritical + vbMsgBoxRight, ""
    
    If Not rst Is Nothing Then rst.Close
    Set rst = Nothing
    Set db = Nothing
End Function

 

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

  • Haha 1
ناقل

ناقل

قام بنشر
قام بنشر
11 دقائق مضت, عمر ضاحى said:

لاحظ هنا حسب الاستعلام عن الكميات بالطريقة المباشرة فى الاستعلامات اعطاني ان كمية البيع هي 190 لكن فى الكود اعطاني 112 اين باقي الكمية ؟

هذا هو الخلل

هذه النتيجة وصلت لها ولكن يبقى السؤال لما تم تجاوز هذه الفواتير ؟؟

 

  • Confused 1
ابوخليل

ابوخليل

قام بنشر
قام بنشر
7 ساعات مضت, jjafferr said:

على بركة الله 

فيه موضوع عمله اخونا ابو جودي ، ما ادري مدى ارتباطة بالموضوع الذي تريد عمله :

 

نعم اطلعت عليه وهو مرجع مهم .. ولكن الفكرة التي اتحدث عنها لم  تأخذ حقها

يمكننا الاستفادة من المثال الأخير في موضوع الأستاذ محمد .. مع حذف جميع الأدوات الموجودة .. وحدات نمطية ، أكواد ، تقارير ، جداول زائدة

والإبقاء فقط على نموذجي الشراء والبيع والجداول المهمة المرتبطة بهذه العمليات

 

  • Like 2

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 مشاركة
الذهاب الي قائمه المواضيع

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information

  I accept