كيفية عمل كود تنبيه

[prosseseur]

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

اريد ان اعرف كيفية عمل كود تنبيه في كشف نقاط على ان تفوق الخلايا النقطة 20

اذا كتب شخص نقطة اكبر من 20 يكون هناك تنبيه للعملية .

شكرا لكم

[الـعيدروس]

السلام عليكم

حط الكود فد حدث الصفحة

مخصص التنبيه على عمود A

Private Sub Worksheet_Change(ByVal Target As Range)

    On Error Resume Next

    If Target.Column <> 1 Then Exit Sub

    T = Target.Row

    If Cells(T, 1) > 20 Then MsgBox "تعدا النقاط 20", vbCritical, "تنبيـة !!!"

End Sub

[الـعيدروس]

اود هكذا بتحدبد مدى

يعمل الكود من السطر الثاني في العمود A

Private Sub Worksheet_Change(ByVal Target As Range)

    On Error Resume Next

    If Target.Column <> 1 Or Target.Row < 2 Then Exit Sub

    If Application.Intersect(Target, Range("a3:a100")) > 20 Then MsgBox "تعدا النقاط 20", vbCritical, "تنبيـة !!!"

End Sub

[prosseseur]

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

إستعملت الكود لكن لم يعمل معي ارجو منكم مثال

مدت سالما

[الـعيدروس]

تفضل

اكتب رقم اكبر من 20 في عمود A

تنبيه.rar

[saad abed]

ابو نصار

بارك الله فيك

تحياتى

سعد عابد

[ريان أحمد]

السلام عليكم بعد إذن أساتذتنا الكرام يمكن إستعمال خاصية التحقق من الصحة كما في المرفق

تنبيه.rar

[محمد يحياوي]

تحية طيبة للاخوة الافاضل طاهر و ابو نصار و سعد عابد ...لاثراء الفكرة تم عمل تنبيه صوتي بالاستعانة بكود اخي ابو نصار ادخل قيمة اكبر من 20 في العمود A ياتيك تنبيه صوتي ....

تنبيه صوتي.rar

[الـعيدروس]

السلام عليكم

الاخ طاهر مشكور على الحل الجميل ولابسيط

الاستاذ الخلوق محمد يحياوي كود خطير بارك الله فيك

وزادك من علمة وفضله

[الـعيدروس]

السلام عليكم

اضافة بسيطة لكود الاستاذ القدير يحياوي

في حالة اذا كان الرقم اكبر من ====> 20 يظهر الصوت - ورسالة تنبيه - والغاء الرقم المدخل

هكذا

Private Declare Function Beep Lib "kernel32" (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long

Private Sub Worksheet_Change(ByVal Target As Range)

	On Error Resume Next

	If Target.Column <> 1 Then Exit Sub

	T = Target.Row

	If Cells(T, 1) > 20 Then Beep 800, 2000: MsgBox "تعد العدد 20", vbCritical, "تبنيـة !!!": Application.Undo

End Sub

[abouelhassan]

اساتذة

شكر وتقدير

اخيكم باحترام

[أبوعبد الله]

أخي العزيز

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

تقبل تحياتي

أبو عبدالله

تنبيه برسالة صوتية.rar

[محمد يحياوي]

الاخوة الافاضل طاهر - ابو نصار - ابو عبد الله حلول جميلة و رائعة

[prosseseur]

تحية طيبة

مشكورين على الجهد الرائع والابداع المتميز

دمتم سالمين

مودتي وتقديري لكم

[الـعيدروس]

السلام عليكم

الاستاذ القدير ابو عبدالله اكسلجي

جزاك الله خير على الكود الجميل

كل يوم نتعلم منكم

وفقك الله

[prosseseur]

لدي استفسار بخصوص كود التنبيه :

كيف يمكن ان نحدد عدد من الاعمدة او مجال معين بهذا الكود ؟

لان هذا الكود يعمل فقط مع عمود واحد فقط .

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

[الـعيدروس]

السلام عليكم

بعد اذن الاستاذ القدير ابو عبدالله اكسلجي

عدلت على الكود لطلبك يعمل على مدى معين فرضاً من a3:c10

هكذا

Private Sub Worksheet_Change(ByVal Target As Range)

    On Error Resume Next

    Dim R_ALI As Range

	 Set R_ALI = Intersect(Target, Range("A3:c10"))

	  If Target.Value <> R_ALI Then Exit Sub

    If R_ALI > 20 Then

   Application.Speech.Speak "Sorry You Entered Number Greater Than 20 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

Target.Select

Target = ""

GoTo 1

End Select

End If

1 End Sub

تنبيه برسالة 1صوتية.rar

[زاكي بوشلاغم]

ممكن رسالة صوتية بالعربية

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

ما شاء الله

مبدعين حقا

جزاكم الله عنا خير الجزاء

وأود ان أضيف أنه يمكنك أيضا إستخدام هذا الكود من خلال نص الرساله فى عده أمور

مثلا لو توجد حاله شراء مرتبطه برقم معين او بحد معين اذا توافر ينبهك صوتيا بإتمام العمليه

وهذا الأمر شبيه بالتنبيه الموجود بالبنوك 

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

وللأسف لم أجد رسائل باللغه العربيه يدعمها الإكسيل

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

أخيكم فى الله

محمود الشريف

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

السلام عليكم

بعد اذن الاستاذ القدير ابو عبدالله اكسلجي

عدلت على الكود لطلبك يعمل على مدى معين فرضاً من a3:c10

هكذا

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    Dim R_ALI As Range
	 Set R_ALI = Intersect(Target, Range("A3:c10"))
	  If Target.Value <> R_ALI Then Exit Sub
    If R_ALI > 20 Then
   Application.Speech.Speak "Sorry You Entered Number Greater Than 20 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
Target.Select
Target = ""
GoTo 1
End Select
End If
1 End Sub

كيف يمكن التعديل على الكود بدلا من أن يكون عملية الإدخال يدويا

لأن الكود لا يتعامل مع المعادلات الموجوده بداخل المدى

فالكود لا يقرأ الا الإدخال فقط

نفترض أن هناك خليه داخل المدى مرتبطه بخليه خارج المدى وكانت نتيجه الخليه خارج المدى 20 بالتالى تكون الخليه الموجوده داخل المدى 20

هنا لا يتعامل معها الكود

[وليد فتحي]

 

السلام عليكم

بعد اذن الاستاذ القدير ابو عبدالله اكسلجي

عدلت على الكود لطلبك يعمل على مدى معين فرضاً من a3:c10

هكذا

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    Dim R_ALI As Range
	 Set R_ALI = Intersect(Target, Range("A3:c10"))
	  If Target.Value <> R_ALI Then Exit Sub
    If R_ALI > 20 Then
   Application.Speech.Speak "Sorry You Entered Number Greater Than 20 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
Target.Select
Target = ""
GoTo 1
End Select
End If
1 End Sub

كيف يمكن التعديل على الكود بدلا من أن يكون عملية الإدخال يدويا

لأن الكود لا يتعامل مع المعادلات الموجوده بداخل المدى

فالكود لا يقرأ الا الإدخال فقط

نفترض أن هناك خليه داخل المدى مرتبطه بخليه خارج المدى وكانت نتيجه الخليه خارج المدى 20 بالتالى تكون الخليه الموجوده داخل المدى 20

هنا لا يتعامل معها الكود

 

 

فعلا الكود لا يعمل مع مدي يوجد به معادلات

فنتمي أحد اساتذة المنتدي أن يقوم بالتعديل على الكود لكي يتعامل مع المدي الذي يوجد به معادلات

[Nazeh Murtada]

يعطيكم العافية 

منتدى مفيد ورائع والكل مبدع ماشاء الله 

 

[ah5316]

 

والله ابداع ماشالله تبارك الله عليكم

[ا بو سليمان]

ما شاء الله تبارك الله  احترنا في  الافضل  فالكل جميل

في ٢٦‏/١١‏/٢٠١١ at 10:51, أبوعبد الله said:

أخي العزيز

 

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

 

تقبل تحياتي

 

أبو عبدالله

تنبيه برسالة صوتية.rar

اخي الفاضل 

 

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

في ٢٥‏/١١‏/٢٠١١ at 17:41, الـعيدروس said:

تفضل

اكتب رقم اكبر من 20 في عمود A

تنبيه.rar

الفكره ممتاز  

 

يبقى  اجمل لو عملت   ذلك من  خلال معادله وليس كود 

 

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

[ابن الملك]

عمل رائع