عمر ضاحى

ما شاء الله ابداع لكن بالنسبه للناس ال مش عوزين ينتظر فتره لفتح النموذج من الممكن جعل هذا النموذج يفتح فى زاوية الشاشة (يظهر ويختفي عند الزاوية) يكون مثلا زي التذكير بالاذكار بحيث نضرب عصفورين بحجر الاول اننا لم نأخر فتح النموذج ثانيا ساعدنا المستخدم على ذكر الله

يا هلا يا هلا يا هلا ما شاء الله على الابداع والتنظيم تختفي ولما تظهر تظهر بابداع جديد سلمت يداك استاذي ابوجودي

هههههههههههههههه ما شاء الله فى كل مره بخسر ((فعلا اللعبه وقفت معايا لما سجلت اسمي انجليزي لكن لما كتبته عربي اشتغل عادي ^_^)) يا عم طلع التركيز بتاعي 0 ههههههههههههه

الخلل ان هناك سجلات مفقوده (لاحظه فى الصورة هنا) من المفترض ان الكود يدور على جميع السجلات فى عمليات البيع لكنه لا يسجل عملية البيع لبعض الاصناف (مجنون شكله ^_^) لاحظ هنا حسب الاستعلام عن الكميات بالطريقة المباشرة فى الاستعلامات اعطاني ان كمية البيع هي 190 لكن فى الكود اعطاني 112 اين باقي الكمية ؟ هذا هو الخلل

يا ريت 🌹🌹🌹

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

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

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

😂 بعد ما نزلت نسخه 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

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

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

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

السادة / جميع اساتذتي الكرام (حفظكم الله) السلام عليكم ورحمة الله وبركاته تحيه طيبه وبعد؛ وكما هو موضح فى العنوان لدي مشكلة فى كود الملف المرفق هذا كود لحساب تكلفة البضاعة حسب طريقة fifo الكود يعمل جيدا لكنه فيه مشكلة خطيره هناك بعض السجلات او الفواتير التى لا يقم بحسابها مما ينتج عن هذا رصيد مخزون غير صحيح ونتائج غير صحيحه (لكن هناك اصناف كثيره لا توجد معها اى مشكلة) انا بحاجه الى مساعده فى حل هذه المشكلة ومن ضمن العينات التى بها مشكلة واضحه الصنف رقم ٣٥٦ والصنف رقم 19 والصنف رقم 3 وغيرها الكثير للاسف فاريد حل لهذه المشكلة وافهم ما سبب هذه المشكلة ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- تنويه: يوجد نموذج بالمرفق وزر باسم بدء كود FIFO عند الضغط عليه يجب الانتظار حتى تنتهي دورة الاحتساب ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- تنويه اخر: القاعدة فيها عمليات بيع غير منطقية (الارصدة السالبة) وهي نتيجة اخطأ فى الكود سابقة تركتها كما هي حتى يمكنني فيما بعد اصدار بها تقارير للاصلاح ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- اخر تنويه : 🙂 الكود وصل لهذا الشكل بعد مساعدة الذكاء الصناعي 🙂 ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- نقطة اخيره : هل لدي احدكم طريقة احصل بها على ارصدة الفعلية للمخزون لجميع الاصناف مره واحده (خاصه ان هناك اكثر من جهاز يقومون بعمليات التسجيل) فكرت فى ان اعمل جدول داخلى وجدول فى القاعدة الخلفيه على السيرفر الجدول على السيرفر هيستلم اى حركه تتم (ادخالات او تعديلات او حذف) وفى هذا الجدول اعمل حقل رقمي بحيث اذا الجهاز رقم 1 عمل اى عملية ترسل للقاعده الخلفية برقم الجهاز 1 كمثال وهكذا مع باقي الاجهزة ثم اعمل كود يقوم بتحديث الارصدة في الجدول المحلى بناءا على الجدول على الشبكه لكن وجدت اني لم احل المشكلة لان ده هيعمل ضغط على السرفر وبالتبعية هتاخد وقت طويل طويل (لاني بعاني منها حاليا) فهل اجد عندكم اقتراح لحل هذه المشكلة؟ ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- عارف ان موضوعي معقد وطويل لاني فعلا احبطة من كثرة التجارب الفاشلة لكن كتبته لعل احدهم يستفاد من هذا الموضوع المعقد 🙂 ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- صور توضيحية للمرفق (هنا اظهرت عينة وهو الصنف رقم 356) ولكم جزيل الشكر Database2_.rar

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

وعليكم السلام استاذى الغالى هل تقصد حاجه زي كده ؟ https://www.officena.net/ib/topic/112991-سِحر-جداول-الاكسس-في-تسجيل-الوقائع/