الفريق العربي للبرمجةأرشيف المنتديات · 2000 – 2023
نسخة أرشيفية للقراءة فقط — التسجيل والمشاركة مغلقان، والمحتوى محفوظ كما كان.

ضروري تعديل في شفرة ارجوكم

بدأه abdullah007 في 11 يونيو 2009 · 0 رد · 307 مشاهدة · في لغة Ms Visual Basic 6 وما قبلها من إصدارات
مشاركة: واتساب X فيسبوك تيليجرام
#1

بســم الله الـرحمــن الرحيــم

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

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

هذي الشفرة ارجوك ايش الحل

Private Sub Command3_Click()

Dim R As Integer

Dim TMPStr As String

Dim SQLStr As String

Dim SQLSt As String

Dim rss As ADODB.Recordset

Dim rs As ADODB.Recordset

' ----- ÇáÊÍÞÞ ãä ÇÏÎÇá ÇáÈíÇäÇÊ -------------------------------------------- '

If Val(Me.Text1.Text) < 1 Then

' ----- ÅÙåÇÑ ÑÓÇáÉ ÊÝíÏ ÈÓÈÈ ÝÔá ÅÓÊßãÇá ÇáÅÌÑÇÁ ------------------------ '

TMPStr = "ÇáÈíÇäÇÊ ÇáãÏÎáÉ äÇÞÕÉ .. ãä ÝÖáß Þã ÈÅÏÎÇá ÑÞã ÇáãÓÊäÏ"

MsgBox TMPStr, vbExclamation Or vbMsgBoxRight Or vbMsgBoxRtlReading, "ÎØÇ Ýí ÇáÅÏÎÇá"

' ----------------------------------------------------------------------- '

Me.Text1.SetFocus ' æÖÚ ÇáãÃÔÑ Úáì ÇáÍÞá ÇáãØáæÈ

Exit Sub ' ÇáÎÑæÌ ãä ÇáÅÌÑÇÁ

End If

If Me.MSHFlexGrid1.Rows = Me.MSHFlexGrid1.FixedRows Then

' ----- ÅÙåÇÑ ÑÓÇáÉ ÊÝíÏ ÈÓÈÈ ÝÔá ÅÓÊßãÇá ÇáÅÌÑÇÁ ------------------------ '

TMPStr = "ÇáÈíÇäÇÊ ÇáãÏÎáÉ äÇÞÕÉ .. ãä ÝÖáß Þã ÈÈíÚ æáæ ÕäÝ æÇÍÏ Úáì ÇáÇÞá"

MsgBox TMPStr, vbExclamation Or vbMsgBoxRight Or vbMsgBoxRtlReading, "ÎØÇ Ýí ÇáÅÏÎÇá"

' ----------------------------------------------------------------------- '

Me.Text4.SetFocus ' æÖÚ ÇáãÃÔÑ Úáì ÇáÍÞá ÇáãØáæÈ

Exit Sub ' ÇáÎÑæÌ ãä ÇáÅÌÑÇÁ

End If

' --------------------------------------------------------------------------- '

' ----- ÍÐÝ ÇáÓÌáÇÊ ÇáÞÏíãÉ ãä ãÓÊäÏ ÇáÈíÚ ÇáÍÇáí ------------------------------- '

Call PoolConnection.Execute("DELETE * FROM fat WHERE DocNo='" & Text1 & "'")

' --------------------------------------------------------------------------- '

Set rs = New ADODB.Recordset

Set rss = New ADODB.Recordset

' ----- ÍÝÙ ÓÌáÇÊ ÇáÌÑíÏ ÏÇÎá ÌÏæá ÇáÈíÚ Ýí ÞÇÚÏÉ ÇáÈíÇäÇÊ --------------------- '

SQLStr = "SELECT * FROM fat WHERE DocNo='" & Text1 & "'"

SQLSt = "SELECT * FROM tab1 "

Dim m1, m2, m3, m4

Call rs.Open(SQLStr, PoolConnection, adOpenStatic, adLockOptimistic)

Call rss.Open(SQLSt, PoolConnection, adOpenStatic, adLockOptimistic)

With MSHFlexGrid1

' ----- Úãá ÊßÑÇÑ ÈÚÏÏ ÇáÓÌáÇÊ Ýí ÇáÌÑíÏ ----------------------------------- '

For R = .FixedRows To .Rows - 1

Call rs.AddNew ' ÇáÊåíÆÉ áÅÖÇÝÉ ÓÌá ÌÏíÏ

' ----- هنا يكون الاضافة في جدول فات ولا فيه اي مشكلة بس المشكلة في الخصم تحت -------------- '

rs("DocNo").Value = Me.Text1.Text

rs("DocDate").Value = Format(Me.DTPicker1.Value, "YYYY/MM/DD")

rs("num").Value = .TextMatrix(R, 1)

rs("iTemPrice").Value = Val(.TextMatrix(R, 3))

rs("iTemQuantity").Value = Val(.TextMatrix(R, 4))

rs("CustomerName").Value = Me.Text2.Text

m1 = Val(.TextMatrix(R, 4))

)) هنا الخطا في عملية الخصم من الجدول تاب طبعا لازم يخصم جميع الارقام المضافة فوق ))))))))

Set rss = DB.Execute("select * from [tab1] where tab1.num = '" & .TextMatrix(R, 1) & "' ")

m2 = rss("c")

If Not rss.EOF Then

m3 = rss("c") - rss("c")

m4 = (m2) - (m1)

m4 = rss!C

End If

' ------------------------------------------------------------------- '

Call rs.Update ' ÅÚÊãÇÏ ÇáÅÖÇÝÉ

Next

' ----------------------------------------------------------------------- '

End With

Call rss.Close

Call rs.Close ' ÅÛáÇÞ ÇáÌÏæá

' --------------------------------------------------------------------------- '

Set rss = Nothing

Set rs = Nothing

Me.Text1.Text = GetDocSerial

End Sub

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

وتحياتي

_.zip

تم تعديل هذه المشاركة بواسطة abdullah007 في 11 يونيو 2009 في 22:11

مواضيع مشابهة