عدم تكرار تاريخ العلاوة اثناء الترحيل

[محمود أبوالدهب]

المطلوب بالفديو الحالى 

وبالنسبة لاخفاء textbox8  عملتها false للفيزابول ومعدتش بتظر 

ملف العمل بالمرفق 

‏‏تحديث علاوات1.rar

[ابراهيم الحداد]

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

استبدل كود الترحيل بهذا الكود

Private Sub CommandButton7_Click()
Me.ComboBox1.Value = ""
Dim ws As Worksheet, x As Integer
Set ws = Worksheets("ss")
x = WorksheetFunction.CountIf(ws.Range("A101:A1000"), CDate(Me.TextBox2.Value))
If x > 0 Then
MsgBox "هذا التاريخ سبقا ادراجه من قبل"
Exit Sub
End If

iRow = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row

ws.Cells(iRow, 1).Value = CDate(Me.TextBox2.Value)
ws.Cells(iRow, 2).Value = Me.TextBox3.Value
ws.Cells(iRow, 3).Value = Me.TextBox4.Value
ws.Cells(iRow, 4).Value = Me.TextBox5.Value
ws.Cells(iRow, 6).Value = Me.TextBox6.Value
ws.Cells(iRow, 7).Value = Me.TextBox7.Value

If CheckBox1.Value = True Then ws.Cells(iRow, 5).Value = True
If CheckBox1.Value = False Then ws.Cells(iRow, 5).Value = False


End Sub

 

[محمود أبوالدهب]

الله عليك استاذ زيزو تمام الله ينور 

ممكن اضافة هل ممكن بردو لو كان التاريخ الى في textbox2 اثناء الاضافة اصغر من اخر تاريخ ممدخل يطلع رسالة ايضا 

تقول تاريخ العلاوة اضغر من اخر تاريخ سبقا ادخاله

من الاول لم اعتقد ان الفورم بياخد كل الجهد ده 

وشاكر جدا للمرة اللميون

[ابراهيم الحداد]

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

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

Private Sub CommandButton7_Click()
Me.ComboBox1.Value = ""
Dim ws As Worksheet, x As Integer, C As Range
Set ws = Worksheets("ss")
x = WorksheetFunction.CountIf(ws.Range("A101:A1000"), CDate(Me.TextBox2.Value))
If x > 0 Then
MsgBox "هذا التاريخ سبقا ادراجه من قبل"
Exit Sub
End If
For Each C In ws.Range("A101:A1000")
If CDate(Me.TextBox2.Value) < C.Value Then
MsgBox "هذا التاريخ اصغر من كل التواريخ المدرجة مسبقا"
Exit Sub
End If
Next
iRow = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row

ws.Cells(iRow, 1).Value = CDate(Me.TextBox2.Value)
ws.Cells(iRow, 2).Value = Me.TextBox3.Value
ws.Cells(iRow, 3).Value = Me.TextBox4.Value
ws.Cells(iRow, 4).Value = Me.TextBox5.Value
ws.Cells(iRow, 6).Value = Me.TextBox6.Value
ws.Cells(iRow, 7).Value = Me.TextBox7.Value

If CheckBox1.Value = True Then ws.Cells(iRow, 5).Value = True
If CheckBox1.Value = False Then ws.Cells(iRow, 5).Value = False
End Sub

 

[محمود أبوالدهب]

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

Private Sub CommandButton7_Click()
Me.ComboBox1.Value = ""
Dim ws As Worksheet, x As Integer, xx As Range

Set ws = Worksheets("ss")
x = WorksheetFunction.CountIf(ws.Range("A101:A100000"), CDate(Me.TextBox2.Value))
If x > 0 Then
MsgBox "ÊÇÑíÎ ÇáÚáÇæÉ ÓÈÞ ÇÏÑÇÌå ãä ÞÈá"
Exit Sub
End If

    For Each xx In ws.Range("A101:A" & ws.Cells(Rows.Count, 1).End(xlUp).Row)
   If xx > CDate(Me.TextBox2.Value) Then
   MsgBox "تاريخ العلاوة اصغر من اخر تاريخ موجود"
   Exit Sub
   End If
Next xx


iRow = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row

ws.Cells(iRow, 1).Value = CDate(Me.TextBox2.Value)
ws.Cells(iRow, 2).Value = Me.TextBox3.Value
ws.Cells(iRow, 3).Value = Me.TextBox4.Value
ws.Cells(iRow, 4).Value = Me.TextBox5.Value
ws.Cells(iRow, 6).Value = Me.TextBox6.Value
ws.Cells(iRow, 7).Value = Me.TextBox7.Value

If CheckBox1.Value = True Then ws.Cells(iRow, 5).Value = True
If CheckBox1.Value = False Then ws.Cells(iRow, 5).Value = False


End Sub

 

لم اكن اعرف انك قمت بالرد استاذنا الفاضل ولكن كنت اجرب حتى اتعلم 

فارجوا لو امكن تقولى لو هناك خطا بالكود الى وضعته

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

اشكرك استاذنا الفاضل فقد ادى الكود الخاص بحضرتك الغرض 100% اشكرك جدا 

[محمود أبوالدهب]

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

Private Sub CommandButton7_Click()
Me.ComboBox1.Value = ""
Dim ws As Worksheet, x As Integer, C As Range
Set ws = Worksheets("ss")

x = WorksheetFunction.CountIf(ws.Range("A101:A100000"), CDate(Me.TextBox2.Value))
If x > 0 Then
MsgBox "تاريخ العلاوة سبق ادراجه من قبل"
Exit Sub
End If

For Each C In ws.Range("A101:A100000")
If CDate(Me.TextBox2.Value) < C.Value Then
MsgBox "تاريخ العلاوة اصغر من اخر تاريخ علاوة سبق ادخالة"
Exit Sub
End If
Next C

If Me.TextBox2.Value = "" Then
MsgBox "برجاء ادخال تاريخ العلاوة"
Exit Sub
End If
If Me.TextBox5.Value = "" Then
MsgBox "برجاء ادخال النسبة المئوية"
Exit Sub
End If
If Me.TextBox6.Value = "" Then
MsgBox "برجاء ادخال اختصار السنة اساسي"
Exit Sub
End If
If Me.TextBox7.Value = "" Then
MsgBox "برجاء ادخال اختصار السنة متغير"
Exit Sub
End If
If CheckBox1.Value = False And CheckBox2.Value = False Then
MsgBox "تحسب العلاوة على ماذا"
Else

iRow = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ws.Cells(iRow, 1).Value = CDate(Me.TextBox2.Value)
ws.Cells(iRow, 2).Value = Me.TextBox3.Value
ws.Cells(iRow, 3).Value = Me.TextBox4.Value
ws.Cells(iRow, 4).Value = Me.TextBox5.Value
ws.Cells(iRow, 6).Value = Me.TextBox6.Value
ws.Cells(iRow, 7).Value = Me.TextBox7.Value

If CheckBox1.Value = True Then ws.Cells(iRow, 5).Value = True
If CheckBox1.Value = False Then ws.Cells(iRow, 5).Value = False
Exit Sub
End If
End Sub

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

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