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

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

قام بنشر (معدل)

السلام عليكم اساتذتى الافاضل

ارجو منكم سعة الصدر لهذه المشكلة وهى : 

المرفق به وظيفة تقوم بحساب الرصيد بعد حركة الصنف الوارد او المنصرف ثم تقوم بحساب متوسط السعر لهذا الصنف وهذه الوظيفة كودها كالتالى :

Option Compare Database
Option Explicit
Dim Balance, bal, i, avg1, avg2, toval, Tovalue, zval, zvalue2 As Long
Dim Cody As String
Function qty_normalize()
'''''''''''''''''''''''''''''''''' Declaring '''''''''''''''''''
Dim db, dbs As DAO.Database
Dim rst As DAO.Recordset
Dim qdf, QryLoop As DAO.QueryDef
Dim item_a, item_b, strSQL As String
Set dbs = CurrentDb: Set db = CurrentDb
For Each QryLoop In CurrentDb.QueryDefs
If QryLoop.name = "Q" Then DoCmd.DeleteObject acQuery, "Q"
Next
''''''''''''''''''''''''''''''''' Building Query '''''''''''
 strSQL = "SELECT Transactions.ID, Transactions.Item, Trans_top.zdate, Transactions.Out, Transactions.[In], Transactions.Zvalue FROM Trans_top INNER JOIN Transactions ON Trans_top.ID = Transactions.Doc "
              ''''''''''  Choosing Item :
 Cody = Forms!Trans_Top!Cody
 strSQL = strSQL + "WHERE (((Transactions.Code)='" & Cody & "')) "
 strSQL = strSQL + "GROUP BY Transactions.ID, Transactions.Item, Trans_top.zdate, Transactions.Out, Transactions.[In], Transactions.Zvalue ORDER BY Transactions.Item, Trans_top.zdate;"

 Set qdf = CurrentDb.CreateQueryDef("Q", strSQL)
DoCmd.OpenQuery qdf.name
Set qdf = db.QueryDefs("Q")
Set rst = qdf.OpenRecordset()
Set rst = CurrentDb.OpenRecordset("Q", dbOpenDynaset)
     If Nz(rst.RecordCount, 0) = 0 Then GoTo en2:
     rst.MoveLast: rst.MoveFirst
        
''''''''''''''''''''''''''''''''' Setting to Zero '''''''''''
           item_a = item_b = rst!Item
           
           Balance = avg1 = avg2 = Tovalue = toval = zval = 0
''''''''''''''''''''''''''''''''' The first Row '''''''''''''
           Balance = rst!In
           CurrentDb.Execute ("Update transactions Set BalanceAfter = " & Balance & " where [id] = " & rst!ID & "")
           'CurrentDb.Execute ("Update transactions Set Zvalue =  " & Zv & " where [id] = " & rst!ID & "")
           avg1 = Round((rst!zvalue) / (rst!In), 5)
           Tovalue = Round((Balance * avg1), 5)
           CurrentDb.Execute ("Update transactions Set AvgPrice = " & avg1 & " where [id] = " & rst!ID & "")
           bal = Balance
           zval = rst!zvalue
           toval = Tovalue
           rst.MoveNext
'''''''''''''''''''''''''''''''''Starting of Row(s) Later '''''''''''''
With rst
    For i = 0 To rst.RecordCount - 1
       If item_a = item_b Then
           Balance = Val(Balance) + rst!In - rst!out
           CurrentDb.Execute ("Update transactions Set BalanceAfter = " & Balance & " where [id] = " & rst!ID & "")
            item_b = rst!Item
             ''''''''''''''''''''''' In Or Out '''''''''''''
             If rst!In <> 0 Then
               avg2 = Round(Round(toval + rst!zvalue, 5) / Round(bal + rst!In, 5), 5)
               Tovalue = Round(Balance * avg2, 5)
               CurrentDb.Execute ("Update transactions Set AvgPrice = " & avg2 & " where [id] = " & rst!ID & "")
               avg1 = avg2
             Else
               avg2 = avg1
               Tovalue = Round(Balance * avg2, 5)
               zvalue2 = Round(avg2 * rst!out, 5)
               CurrentDb.Execute ("Update transactions Set AvgPrice = " & avg2 & " where [id] = " & rst!ID & "")
               CurrentDb.Execute ("Update transactions Set zvalue = " & zvalue2 & " where [id] = " & rst!ID & "")
             End If
           
           ''''''''''''''''''''''' A new Item '''''''''''''
        Else
           Balance = 0
           item_b = rst!Item
           Balance = Val(Balance) + rst!In - rst!out
           CurrentDb.Execute ("Update transactions Set BalanceAfter = " & Balance & " where [id] = " & rst!ID & "")
           avg1 = Round(rst!zvalue, 5) / Round(rst!In, 5)
           Tovalue = Round(Balance * avg1, 5)
           CurrentDb.Execute ("Update transactions Set AvgPrice = " & avg1 & " where [id] = " & rst!ID & "")
        End If
        ''''''''''''''''''''''' Storing Values '''''''''''''
               toval = Tovalue
               bal = Balance
               zval = rst!zvalue
       ''''''''''''''''''''''' Next Row or End ''''''''''''''
      .MoveNext
           If Not .EOF Then
           item_a = rst!Item
           Else
           GoTo en1:
           End If
   Next
          
End With
en1:
         rst.Close
         DoCmd.Close acQuery, "Q", acSaveYes
         DoCmd.DeleteObject acQuery, "Q"
         Set rst = Nothing
         Set qdf = Nothing
         Set db = Nothing
         Set dbs = Nothing
en2:
For Each QryLoop In CurrentDb.QueryDefs
If QryLoop.name = "Q" Then DoCmd.Close acQuery, "Q", acSaveYes: DoCmd.DeleteObject acQuery, "Q"
Next
End Function

ويعمل هذا الكود بعد تحديث الحقل Zvalue فى النموذج الفرعى الموجود بالنموذج Trans_Top ولكن المشكلة كالتالى :

1- اذا لم يكن هناك حركة سابقة من نفس الصنف لا يقوم البرنامج بحساب AvgPrice ويظهر رسالة "No Current Record"

2- اذا كان هناك حركة سابقة يقوم البرنامج بحساب AvgPrice الخاص بالحركة السابقة ويترك الحركة الحالية بدون حساب = 0

اما المفروض ان يحدث :

اذا لم يكن هناك حركة سابقة على الصنف فأن متوسط السعر AvgPrice يساوى القيمة zvalue / كمية الاضافة

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

 

توجيهات لاستخدام المرفق :

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

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

 

 

 

avg.rar

تم تعديل بواسطه Amr Ashraf

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