تنبيه عند تجاوز التسلسل

[الشيباني1]

اخواني الاعزاء تحية طيبه ارجو المساعده فيما جاء بالمرفق مع الامتنان

Book1.rar

[رجب جاويش]

السلام عليكم

تفضل أخى

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B6:B26")) Is Nothing Then
If Target.Count > 1 Then Exit Sub
    If Target - Target.Offset(-1) <> 1 Then
        ansr = MsgBox("أنت تتجاوز الرقم التسلسلى هل تريد الإستمرار", vbYesNo)
        If ansr = vbNo Then
            Application.EnableEvents = False
            Target = ""
            Target.Select
            Application.EnableEvents = True
            Exit Sub
        End If
    End If
End If
End Sub

تجاوز الرقم التسلسلى.rar

[جمال عبد السميع]

 كود رائع أستاذى " رجب جاويش "

تقبل تحياتى

[الشيباني1]

استاذنا القدير كود رائع من استاذ اروع ادامكم الرحمن معينا لنا

[جمال عبد السميع]

طبعا حل المعادلات لايمكن أن يغنى عن الكود وخاصا فى مثل هذه الحالة

ولكن هذه فكرة بالمعاددلات أعتقد إنها فكرة يمكن الأستفادة منها فى الكثير

 

Book1.rar

[أم عبد الله]

أستاذنا الكبير / رجب جاويش

 

أستاذنا ملك المعادلات / جمال عبد السميع

 

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

 

جزاكم الله خيراً على هذه الحلول الرائعة وكود أستاذنا رجب جاويش رائع جداً لأن يسأل عن تجاوز الر قم أم لا كما طلب السائل وكنت حضرت ملف بسيط يفي بالغرض بمعادلة وتنسيق شرطي ولكن عندما رأيت الكود تراجعت عن رفعه وعندما رأيت معادلة أستاذنا العبقري وددت ان أشاركه لإثراء الموضوع. لكم كل التحية والتقدير.

Book2.rar

[رجب جاويش]

أخى الحبيب / جمال عبد السميع

جزاك الله خير

[رجب جاويش]

الأخت الفاضلة / أم عبد الله

جزاكى الله كل خير

[محمود_الشريف]

ما شاء الله 

أعمال فى منتهى الروعة

 

وبعد إذن أساتذتى ومن لهم الفضل بعد رب العالمين فى تعلم المزيد ومعرفة الكثير عن عالم الاكسل

 

أستاذى القدير // رجب جاويش

الأستاذ القدير // جمال عبد السميع

الأستاذة القديرة // أم عبد الله

 

اثراء للموضوع اليكم نموذج للتنبية والتخيير ولكن صوتيا وبرساله

 

اسأل الله عز وجل أن أكون وفقت فى ذلك الأمر

 

تقبلوا منى وافر الإحترام والتقدير

تجاوز الرقم التسلسلى1.rar

[رجب جاويش]

أخى الحبيب / محمود الشريف

عمل رائع تسلم ايديك

ولو سمحت لى أخى الحبيب بتعديل بسيط على الكود لمنع تكرار الرسالة بشكل مستمر عند الضغط على زر NO

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Dim R_ALI As Range
Set R_ALI = Intersect(Target, Range("B6:B26"))
If Target.Count > 1 Then Exit Sub
If Target - Target.Offset(-1) <> 1 Then
Application.Speech.Speak "Sorry you exceed the serial number  If You Want To Keep It Press Yes Else Press No"
Choices = MsgBox(" YES " & "إذا كنت تريد الإبقاء على الإدخال الحالي إضغط " & vbNewLine & " NO " & "وإذا كنت تريد حذف الإدخال الحالي إضغط ", vbYesNoCancel, "تحديد المطلوب")
Select Case Choices
Case vbYes
Exit Sub
Case vbNo
Application.EnableEvents = False
Target.Select
Target = ""
Application.EnableEvents = True
End Select
End If
End Sub

[محمود_الشريف]

أخى فى الله

أستاذى القدير // رجب جاويش

بارك الله فيكم

الأستاذ يستأذن من التلميذ (( آدام الله عليكم نعمه وفضله أستاذى القدير ))

وتعديل فى محله 

 

مرفق الملف بعد التعديل 

دمتم فى أمان الله وحفظه

وتقبل منى وافر الاحترام والتقدير

تجاوز الرقم التسلسلى2.rar

[الحسن الحسن]

جميلة فكرة التنبية بالصوت

جزاكم الله خيرا