اذهب الي المحتوي
أوفيسنا

الردود الموصى بها

قام بنشر

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

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

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

شكرا لكم

  • Like 1
قام بنشر

السلام عليكم

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

مخصص التنبيه على عمود 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

  • Like 1
قام بنشر

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

يعمل الكود من السطر الثاني في العمود 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

  • Like 1
قام بنشر

السلام عليكم

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

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

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

  • Like 1
قام بنشر

السلام عليكم

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

في حالة اذا كان الرقم اكبر من ====> 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

  • Like 1
قام بنشر

أخي العزيز

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

تقبل تحياتي

أبو عبدالله

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

  • Like 3
قام بنشر

السلام عليكم

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

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

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

وفقك الله

قام بنشر

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

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

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

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

قام بنشر

السلام عليكم

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

عدلت على الكود لطلبك يعمل على مدى معين فرضاً من 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

  • Like 1
  • 1 year later...
  • 2 months later...
قام بنشر

ما شاء الله

مبدعين حقا

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

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

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

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

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

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

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

أخيكم فى الله

محمود الشريف

  • Like 1
قام بنشر

السلام عليكم

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

عدلت على الكود لطلبك يعمل على مدى معين فرضاً من 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

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

  • Like 3
قام بنشر

 

السلام عليكم

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

عدلت على الكود لطلبك يعمل على مدى معين فرضاً من 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

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

 

 

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

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

  • 1 year later...
قام بنشر

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

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

أخي العزيز

 

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

 

تقبل تحياتي

 

أبو عبدالله

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

اخي الفاضل 

 

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

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

تفضل

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

تنبيه.rar

الفكره ممتاز  

 

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

 

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

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information