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

[2saad]

إخواني أعضاء المنتدي الكرام بعد سلام الله عليكم ورحمة الله وبركاته

محتاج للفورم المرفق بالملف

عند رصد الدرجات عن طريق الفورم وزادت الدرجة عن الدرجة العليا الملونة باللون الأصفر بالشيت يعطيني رسالة تنية بأن الدرجة المدخلة غير صحيحة

رزة1.xlsm

[رضا على]

ارجوا ان يكون هو المطلوب

رزة1.xlsm

[2saad]

شكرا لرد حضرتك

ولكن ليس هذا المطلوب

عند رصد الدرجات عن طريق الفورم وزادت الدرجة عن الدرجة العليا الملونة باللون الأصفر بالشيت يعطيني رسالة تنية بأن الدرجة المدخلة غير صحيحة

الملف المرفق مرة ثانيةرزة1.xlsm

[أ / محمد صالح]

يمكنك إضافة هذا الكود في حدث الخروج من جميع مربعات النصوص

وهذا كود مربع النص الأول كمثال

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim ws As Worksheet
Set ws = Worksheets("ملف التقييم صف رابع نصف العام")
If Val(Me.TextBox1.Value) > ws.Cells(10, 5).Value Then
MsgBox "يجب أن تكون الدرحة أقل من أو تساوي " & ws.Cells(10, 5).Value
Me.TextBox1.Value = ""
Cancel = True
End If
End Sub

 

وهكذا مع باقي مربعات النصوص textbox

لاحظ رقم العمود 5 سيتغير ورقم التيكست بوكس 1 سيتغير

أما 10 فهو رقم الصف الذي به النهاية العظمى للمادة

بالتوفيق

[2saad]

السلام عليكم

شكرا لحضرتك يا استاذ محمد

أنا عملت زي ما حضرتك قلت ولكن فيه خطا رزة1.xlsm

[محمد هشام.]

 

رزة1 (2).xlsm

تم تعديل نوفمبر 4, 2023 بواسطه محمد هشام.

[أ / محمد صالح]

أخي الكريم @2saad

يبدو أن حضرتك لم تنتبه لتعديل مشاركتي

بوضع كلمة val قبل قيمة مربع النص لتحويلها إلى رقم

بالتوفيق

[2saad]

شكرا لكم جميعا وبارك الله لكم وجعله في ميزان حسناتكم

ممكن تعديل بسيط لو ينفع عندما اضغط علي الكومنت بوتن يرحل البيانات ويفرغ التكست بوكسات

[محمد هشام.]

Private Sub CommandButton1_Click()
Dim lr As Long
Dim ws As Worksheet: Set ws = Sheet8
Application.ScreenUpdating = False
lr = ws.Cells(Rows.Count, 5).End(xlUp).Row
lr = lr + 1
ws.Cells(lr, 5) = Me.TextBox1.Value
ws.Cells(lr, 6) = Me.TextBox2.Value
ws.Cells(lr, 7) = Me.TextBox3.Value
ws.Cells(lr, 8) = Me.TextBox4.Value
ws.Cells(lr, 9) = Me.TextBox5.Value
ws.Cells(lr, 10) = Me.TextBox6.Value
ws.Cells(lr, 11) = Me.TextBox7.Value
ws.Cells(lr, 12) = Me.TextBox8.Value
ws.Cells(lr, 13) = Me.TextBox9.Value
ws.Cells(lr, 14) = Me.TextBox10.Value
ws.Cells(lr, 15) = Me.TextBox11.Value
ws.Cells(lr, 16) = Me.TextBox12.Value
ws.Cells(lr, 17) = Me.TextBox13.Value
For i = 1 To 13
Controls("textbox" & i).Text = ""
Next i
Application.ScreenUpdating = True

End Sub

 او 

Private Sub CommandButton1_Click()
Dim lr As Long
Dim ws As Worksheet: Set ws = Sheet8
Application.ScreenUpdating = False
        lr = ws.Range("E" & Rows.Count).End(xlUp).Row
        With ws
            .Cells(lr + 1, "E").Value = Me.TextBox1.Value
            .Cells(lr + 1, "F").Value = Me.TextBox2.Value
            .Cells(lr + 1, "G").Value = Me.TextBox3.Value
            .Cells(lr + 1, "H").Value = Me.TextBox4.Value
            .Cells(lr + 1, "I").Value = Me.TextBox5.Value
            .Cells(lr + 1, "J").Value = Me.TextBox6.Value
            .Cells(lr + 1, "K").Value = Me.TextBox7.Value
            .Cells(lr + 1, "L").Value = Me.TextBox8.Value
            .Cells(lr + 1, "M").Value = Me.TextBox9.Value
            .Cells(lr + 1, "N").Value = Me.TextBox10.Value
            .Cells(lr + 1, "O").Value = Me.TextBox11.Value
            .Cells(lr + 1, "P").Value = Me.TextBox12.Value
            .Cells(lr + 1, "Q").Value = Me.TextBox13.Value
End With
For i = 1 To 13
Controls("textbox" & i).Text = ""
Next i
Application.ScreenUpdating = True

End Sub

 

تم تعديل نوفمبر 4, 2023 بواسطه محمد هشام.

[2saad]

أستاذنا الكبير / محمد هشام

بارك الله فيك وأكثر الله من أمثالك