09-09-19, 07:19 PM
المثال الذي وضعته لا يوجد به خطأ حفظ عندي السجلات لكن اريد ان اسالك لماذا وضعت رسالة تأكيد الحفظ في كل سجل في الجدول فقط ضعها قبل for و اغلق الشرط بعد next .
09-09-19, 07:19 PM
10-09-19, 09:10 AM
بجرب وارد لك خبر
لم يعمل بالشكل المطلول يعطي لي رسالة "تم حفظ الفاتورة " بتكرار عدد العناصر
وكمان اريد شرط اذا الجريد خالي من البيانات "حدد عنصر واحد على الاقل"
اذا اي من صناديق boxs خالي اريد رسالة اكتب البيانات
في رقم المعميل ,اسم العميل , البيان , ....الخ
لم يعمل بالشكل المطلول يعطي لي رسالة "تم حفظ الفاتورة " بتكرار عدد العناصر
وكمان اريد شرط اذا الجريد خالي من البيانات "حدد عنصر واحد على الاقل"
اذا اي من صناديق boxs خالي اريد رسالة اكتب البيانات
في رقم المعميل ,اسم العميل , البيان , ....الخ
10-09-19, 10:47 AM
PHP كود :
'بسم الله الرحمن الرحيم نبدء'
'الغ fox.Rows = 14'
'ضع بدل عنها'
fox.Rows = 0
'ضع هذا الكود في زر الحفظ قبل اللوب'
'إذا كان الجدول فارغ'
Dim flag As Boolean
Dim r, c As Integer
With fox
flag = True
For r = 1 To .Rows - 1
For c = 1 To .Cols - 1
If .TextMatrix(r, c) <> vbNullString Then
flag = False
End If
Next c
Next r
End With
If flag = True Then
MsgBox "لا يمكن حفظ الفاتورة الجدول فارغ"
Exit Sub
End If
'تفقد اذا كان هناك تكست بوكس فارغ في الفورم'
Dim X As Integer
For X = 0 To Me.Controls.Count - 1
If TypeOf Me.Controls(X) Is TextBox Then
If Me.Controls(X).Text = "" Then
MsgBox "الرجاء تعبئة جميع الحقول النصية"
Exit Sub
End If
End If
Next X
'كود الحفظ'
'بعد Next الخاص بالحفظ ضع End If'
'عدل كود Timer2 ليكون كالتالي'
Private Sub Timer2_Timer()
If Getasynckeystate(120) Then
ItemsID = ""
Form4.Show 1
fox.TextMatrix(fox.Row, 0) = ItemsID
If ItemsID > 0 Then
fox.Rows = fox.Rows + 1
End If
End If
End Sub
تعديل إضافي للتايمر :
PHP كود :
Private Sub Timer2_Timer()
If Getasynckeystate(120) Then
ItemsID = ""
Form4.Show 1
fox.TextMatrix(fox.Row, 0) = ItemsID
If ItemsID > 0 Then
fox.Rows = fox.Rows + 1
End If
End If
If fox.TextMatrix(fox.Rows - 1, 0) = "" And fox.TextMatrix(fox.Rows - 2, 0) = "" Then
fox.RemoveItem (fox.Rows - 1)
End If
End Sub
و اذا اردت ضع الكود التالي في حدث الدبل كليك بـ Fox اي بالداتا غريد الخاص بالأصناف كالتالي :
PHP كود :
Private Sub fox_DblClick()
ItemsID = 0
Form4.Show 1
fox.TextMatrix(fox.Row, 0) = ItemsID
If ItemsID > 0 Then
fox.Rows = fox.Rows + 1
End If
End Sub
تعديل أخير :
PHP كود :
Private Sub fox_DblClick()
ItemsID = 0
Form4.Show 1
fox.TextMatrix(fox.Row, 0) = ItemsID
If ItemsID > 0 Then
fox.Rows = fox.Rows + 1
End If
fox.Refresh
fox.Row = fox.Rows - 1
fox.Col = 0
fox.RowSel = fox.Rows - 1
End Sub
10-09-19, 01:13 PM
العفو اخي ماضبطت معي ابدا يعمل تكرار لرسال "هل تريد حفظ الفاتورة "
عادي مابتعبك اخي الغالي وشكراً على محاولتك مساعدتي ولك جزيل الشكر
احترمك
عادي مابتعبك اخي الغالي وشكراً على محاولتك مساعدتي ولك جزيل الشكر
احترمك
10-09-19, 01:26 PM
زر الحفظ كاملا :
PHP كود :
Private Sub Command1_Click()
'إذا كان الجدول فارغ'
Dim flag As Boolean
Dim r, c As Integer
With fox
flag = True
For r = 1 To .Rows - 1
For c = 1 To .Cols - 1
If .TextMatrix(r, c) <> vbNullString Then
flag = False
End If
Next c
Next r
End With
If flag = True Then
MsgBox "لا يمكن حفظ الفاتورة الجدول فارغ"
Exit Sub
End If
'تفقد اذا كان هناك تكست بوكس فارغ في الفورم'
Dim X As Integer
For X = 0 To Me.Controls.Count - 1
If TypeOf Me.Controls(X) Is TextBox Then
If Me.Controls(X).Text = "" Then
MsgBox "الرجاء تعبئة جميع الحقول النصية"
Exit Sub
End If
End If
Next X
If MsgBox("هل تريد بالفعل حفظ بيانات الفاتورة", vbYesNo, "") = vbYes Then
Dim I As Integer
For I = 1 To fox.Rows - 1
If Trim$(fox.TextMatrix(I, 0)) <> "" And Val(Trim$(fox.TextMatrix(I, 0))) > 0 Then
Set RS = New ADODB.Recordset
If RS.State = adStateOpen Then RS.Close
RS.CursorLocation = adUseClient
RS.Open "select* from BillItems ", DB, adOpenStatic, adLockPessimistic
RS.AddNew
RS!Id = Val(Trim$(fox.TextMatrix(I, 0)))
RS!Name = Trim$(fox.TextMatrix(I, 1))
RS!Qty = Val(Trim$(fox.TextMatrix(I, 3))) ''3
RS.Update
DoEvents
Set RS2 = New ADODB.Recordset
If RS2.State = adStateOpen Then RS2.Close
RS2.CursorLocation = adUseClient
RS2.Open "Select * From Store Where iD=" & Val(Trim$(fox.TextMatrix(I, 0))), DB, adOpenStatic, adLockPessimistic
If RS2.RecordCount > 0 Then
RS2![noo] = RS2![noo] - Val(Trim$(fox.TextMatrix(I, 3))) ''3
RS2.Update
DoEvents
MsgBox "تمت عملية الحفظ بنجاح", vbMsgBoxRtlReading + vbInformation, "حفظ فاتورة"
Else
MsgBox "لم يتم حفظ الفاتورة", vbMsgBoxRtlReading + vbInformation, "حفظ فاتورة"
Exit Sub
End If
End If
Next
End If
End Sub
10-09-19, 01:36 PM
الكود شغال 100% جزاك الله خير بس الرسالة "تم حفظ الفاتورة " بكررها على حسب عدد الاصناف المضافة
وهذه مشكلة
مع ان الكود الخاص بك شغال حلاوة اخي الغالي وجزاك الله عنا خيرا ً
حلو جد خاصية التايمر عجبتنا مرررة
ربي يحفظ ك ويسلمك
وهذه مشكلة
مع ان الكود الخاص بك شغال حلاوة اخي الغالي وجزاك الله عنا خيرا ً
حلو جد خاصية التايمر عجبتنا مرررة
ربي يحفظ ك ويسلمك
10-09-19, 01:55 PM
هذا هو الحل :
PHP كود :
Private Sub SaveBill()
Dim X As Integer
'تفقد اذا كان هناك تكست بوكس فارغ في الفورم'
For X = 0 To Me.Controls.Count - 1
If TypeOf Me.Controls(X) Is TextBox Then
If Me.Controls(X).Text = "" Then
MsgBox "الرجاء تعبئة الحقول النصية"
Exit Sub
End If
End If
Next X
If MsgBox("هل تريد بالفعل حفظ بيانات الفاتورة", vbYesNo, "") = vbYes Then
Dim I As Integer
For I = 1 To fox.Rows - 1
If Trim$(fox.TextMatrix(I, 0)) <> "" And Val(Trim$(fox.TextMatrix(I, 0))) > 0 Then
Set RS = New ADODB.Recordset
If RS.State = adStateOpen Then RS.Close
RS.CursorLocation = adUseClient
RS.Open "select* from BillItems ", DB, adOpenStatic, adLockPessimistic
RS.AddNew
RS!Id = Val(Trim$(fox.TextMatrix(I, 0)))
RS!Name = Trim$(fox.TextMatrix(I, 1))
RS!Qty = Val(Trim$(fox.TextMatrix(I, 3))) ''3
RS.Update
DoEvents
Set RS2 = New ADODB.Recordset
If RS2.State = adStateOpen Then RS2.Close
RS2.CursorLocation = adUseClient
RS2.Open "Select * From Store Where iD=" & Val(Trim$(fox.TextMatrix(I, 0))), DB, adOpenStatic, adLockPessimistic
If RS2.RecordCount > 0 Then
RS2![noo] = RS2![noo] - Val(Trim$(fox.TextMatrix(I, 3))) ''3
RS2.Update
DoEvents
Else
MsgBox "لم يتم حفظ الفاتورة ", vbMsgBoxRtlReading + vbInformation, "تنبية"
Exit Sub
End If
End If
Next
MsgBox "تمت عملية حفظ الفاتورة ", vbMsgBoxRtlReading + vbInformation, "تنبية"
End If
End Sub
Private Sub Command1_Click()
'إذا كان الجدول فارغ'
Dim flag As Boolean
Dim r, c As Integer
With fox
flag = True
Dim strXX As String
For r = 1 To .Rows - 1
For c = 0 To .Cols - 1
strXX = .TextMatrix(r, c)
If strXX > "" Then
flag = False
Call SaveBill
Exit Sub
End If
Next c
Next r
End With
If flag = True Then
MsgBox "الجدول فارغ الرجاء تعبئته"
Exit Sub
End If
End Sub
10-09-19, 02:00 PM
جزاك الله خير اخي الغالي asemshahen5 ربي يحفظك ويجزيك كل الخير
ويجعلك سعيدا دائما وابدا ويرزقك من حيث لاتدري رزقاً كثيرا يجعلك تتفاجئ به
اللهم امين
احترمك اخي الغالي والعزيز وشكراً على مجهودك البناء في مساعدتي
اعزك واحترمك
اخوك محمد
ويجعلك سعيدا دائما وابدا ويرزقك من حيث لاتدري رزقاً كثيرا يجعلك تتفاجئ به
اللهم امين
احترمك اخي الغالي والعزيز وشكراً على مجهودك البناء في مساعدتي
اعزك واحترمك
اخوك محمد
10-09-19, 02:03 PM
الله يسلمك و يحفظك اتدري رجعتني للوراء الى عام 2002 - 2003 لايام الذكريات الجميلة بارك الله فيك .
10-09-19, 02:06 PM
الله يسلمك ويعافيك ويبارك فيك