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

طلب تطوير كود


إذهب إلى أفضل إجابة Solved by سليم حاصبيا,

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

السلام عليكم

في الملف المرفق تم اضافة كود لاظهار رسالة خطأ عندما تكون قيمة الخلية B1 سالبه 

المطلوب هو تطوير الكود ليشمل كل الخلايا الملونة بالاصفر  اي من  B1  ولغاية D20 

وللامانة الكود اخذته من احد مشاركات الاستاذ m.hindawi احد عضاء منتدانا جزاه الله خيرا وقمت بتغيير بسيط فيه.

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

تطوير كود.rar

رابط هذا التعليق
شارك

جرب هذا الماكرو

اذا وجدت اي خلية اصغر من صفر يقوم الكود بتحديدها لاصلاحها

Dim Rg As Range
Dim cel As Range, first_ad$, Other_Ad$

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.EnableEvents = False
Range("B1:D20").Interior.ColorIndex = 6
If Not Intersect(Target, Range("B1:D20")) Is Nothing _
    And Target.Count = 1 Then
    Set Rg = Range("B1:D20").Find("-", lookat:=2)
      If Not Rg Is Nothing Then
       first_ad = Rg.Address: Other_Ad = first_ad
           Do
            Rg.Interior.ColorIndex = 50
            Set Rg = Range("B1:D20").FindNext(Rg)
            Other_Ad = Rg.Address
            If Other_Ad = first_ad Then Exit Do
          Loop
      End If
Else
    For Each cel In Range("B1:D20")
     If cel < 0 Then cel.Interior.ColorIndex = 50
    Next
End If
Application.EnableEvents = True
End Sub

الملف مرفق

 

 

MY_code.xlsm

  • Like 2
رابط هذا التعليق
شارك

الاخ سليم حاصبيا

كل الشكر للرد

ولكني اردت تطوير الكود المرفق ليشمل كل الخلايا 

بحيث عند وضع قيمه سالبه في اي منها يتوقف العمل ويظهر رسالة تنبيه

رابط هذا التعليق
شارك

  • أفضل إجابة

عندها يلزم هذا الكود

Dim cel As Range

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Not Intersect(Target, Range("B1:D20")) Is Nothing _
    And Target.Count = 1 Then
    Range("B1:D20").Interior.ColorIndex = 6
     For Each cel In Range("B1:D20")
        If cel < 0 Then cel.Interior.ColorIndex = 50
     Next
Else
     Application.EnableEvents = True: Exit Sub
End If
  If Not IsNumeric(Target) Or Target < O Then
    Target.Interior.ColorIndex = 50
    Target.Select
    MsgBox "خطأ" & Chr(10) & _
    "مسموح فقط بأعداد اكبر من صفر", 16, _
    vbMsgBoxRight
  End If

 Application.EnableEvents = True
End Sub

الملف من جديد

 

MY_NEW_CODE.xlsm

  • Like 2
رابط هذا التعليق
شارك

من فضلك سجل دخول لتتمكن من التعليق

ستتمكن من اضافه تعليقات بعد التسجيل



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

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

Important Information