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

[أبو أية]

الأخوة الأعزاء فى هذا المنتدى الرائع نفعنا الله بعلمك ونفعكم بكل ما تقدموه من مجهود ومساهمات فى هذا المنتدى العملاق...

كنت قد طرحت موضوع بخصوص جبر رقم معين إلى رقم آخر باستخدام الماوس وبفضل من الله أولا، ثم مساهمات بعض عمالقة هذا المنتدى مثل الأستاذ الحبيب (خفيف الظل) الأستاذ ياسر وكذلك الأخت فاطمة جزاهم الله خير الجزاء. توصلت إلى الكود المطلوب.

حاولت إجراء تعديل بسيط على الكود لكى يشمل الكود أكثر من شرط ولكنى لم استطيع التوصل إلى اى حل لخبرتى المعدومة فى هذا المجال

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

وبارك الله فى جميع أعضاء هذا المنتدى ونفع بهم...

 

 

 

 

 

نموذج كنترول شيت2.rar

[أبو أية]

علماً بأن الكود كالتالى:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Set UnionRange1 = Union(Range("E5:U5,E8:U8,E11:U11,E14:U14,E17:U17,E20:U20,E23:U23,E26:U26,E29:U29"), _
               Range("E32:U32,E35:U35,E38:U38,E41:U41,E44:U44,E47:U47,E50:U50"), _
               Range("E53:U53,E56:U56,E59:U59,E62:U62,E65:U65,E68:U68,E71:U71"), _
               Range("E74:U74,E77:U77,E80:U80,E83:U83,E86:U86,E89:U89,E92:U92"), _
               Range("E95:U95,E98:U98,E101:U101,E104:U104,E107:U107,E110:U110,E113:U113"), _
               Range("E116:U116,E119:U119,E122:U122,E125:U125,E128:U128,E131:U131,E134:U134"), _
               Range("E137:U137,E140:U140,E143:U143,E146:U146,E149:U149,E152:U152"))

    If Not Intersect(Target, UnionRange1) Is Nothing Then
        If Target.Value >= "40" And Target.Value < "50" Then
        Cancel = True
        Target.Value = "50"
        Else
        Cancel = False
        
        End If
    End If
    
    Set UnionRange2 = Union(Range("J3:U3,J6:U6,J9:U9,J12:U12,J15:U15,J18:U18,J21:U21,J24:U24,J27:U27"), _
               Range("J30:K30,J33:K33,J36:K36,J39:K39,J42:K42,J45:K45,J48:K48"), _
               Range("J51:K51,J54:K54,J57:K57,J60:K60,J63:K63,J66:K66,J69:K69"), _
               Range("J72:K72,J75:K75,J78:K78,J81:K81,J84:K84,J87:K87,J90:K90"), _
               Range("J93:K93,J96:K96,J99:K99,J102:K102,J105:K105,J108:K108,J111:K111"), _
               Range("J114:K114,J117:K117,J120:K120,J123:K123,J126:K126,J129:K129,J132:K132"), _
               Range("J135:K135,J138:K138,J141:K141,J144:K144,J147:K147,J150:K150"))

    If Not Intersect(Target, UnionRange2) Is Nothing Then
        If Target.Value >= "20" And Target.Value < "25" Then
        Cancel = True
        Target.Value = "25"
        Else
        Cancel = False
        
        End If
    End If
 
    
    Set UnionRange3 = Union(Range("V5:U5,V8:U8,V11:U11,V14:U14,V17:U17,V20:U20,V23:U23,V26:U26,V29:U29"), _
               Range("V5,V8,V11,V14,V17,V20,V23,V26,V29"), _
               Range("V32,V35,V38,V41,V44,V47,V50"), _
               Range("V53,V56,V59,V62,V65,V68,V71"), _
               Range("V74,V77,V80,V83,V86,V89,V92"))

    If Not Intersect(Target, UnionRange3) Is Nothing Then
        If Target.Value >= "1088" And Target.Value < "1105" Then
        Cancel = True
        Target.Value = "1105"
        End If
        If Target.Value >= "1343" And Target.Value < "1360" Then
        Cancel = True
        Target.Value = "1360"
        End If
        If Target.Value >= "1513" And Target.Value < "1530" Then
        Cancel = True
        Target.Value = "1530"
        Else
        Cancel = False
       End If
   End Sub
     

تم تعديل أبريل 2, 2015 بواسطه أبو أية

[ياسر خليل أبو البراء]

أخي الفاضل أبو آية ..حاول توضح بمزيد من التفاصيل المطلوب بالضبط ..

واشرح الهدف من الكود ..لأن الكود من فترة والواحد عنده زهايمر

[أبو أية]

 

الأخ الحبيب / أ. ياسر

الكود السابق كان  لتطبيق عملية جبر بالنسبة للطالب الحاصل على درجة أقل من 50 وأكبر من أو تساوى 40 بحيث عند تنفيذ الجبر لا يتجاوز 10 درجات فمثلا الطالب الحاصل على درجة 40 فى مادة معينة يتم جبره إلى 50 (درجة النجاح) وذلك باستخدام الماوس بالضغط دبل كليك على الرقم المطلوب جبره..

أما بالنسبة للتعديل المطلوب فهو بخصوص المجموع الكلى فمن حق الطالب فى قواعد الجبر 10 درجات على سبيل المثال وبالتالى فإن الطالب الحاصل على مجموع كلى بنسبة أقل من 65% (وهى بداية التقدير جيد) بـ 10 درجات يمكن جبره إلى الحد الأدنى للتقدير جيد

مثال : بفرض طالب حاصل على مجموع 1096 من 1700 المجموع الكلى .

فالمطلوب جبره إلى 1105 ليحصل على تقدير جيد

كذالك طالب حاصل على 1350 من 1700 فالمطلوب جبره إلى 1360 ليحصل على تقدير جيد جداً... وهكذا

(مع العلم أن تقدير جيد يبدأ من 1105 وتقدير جيد جدا يبدأ من 1360 وتقدير ممتاز يبدأ من 1530)

أتمنى أن أكون قد وفقت فى شرح المطلوب.. بارك الله فيكم

 

تم تعديل أبريل 2, 2015 بواسطه أبو أية

[ياسر خليل أبو البراء]

جرب الكود بهذا الشكل

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Set UnionRange1 = Union(Range("E5:U5,E8:U8,E11:U11,E14:U14,E17:U17,E20:U20,E23:U23,E26:U26,E29:U29"), _
               Range("E32:U32,E35:U35,E38:U38,E41:U41,E44:U44,E47:U47,E50:U50"), _
               Range("E53:U53,E56:U56,E59:U59,E62:U62,E65:U65,E68:U68,E71:U71"), _
               Range("E74:U74,E77:U77,E80:U80,E83:U83,E86:U86,E89:U89,E92:U92"), _
               Range("E95:U95,E98:U98,E101:U101,E104:U104,E107:U107,E110:U110,E113:U113"), _
               Range("E116:U116,E119:U119,E122:U122,E125:U125,E128:U128,E131:U131,E134:U134"), _
               Range("E137:U137,E140:U140,E143:U143,E146:U146,E149:U149,E152:U152"))

    If Not Intersect(Target, UnionRange1) Is Nothing Then
        If Target.Value >= "40" And Target.Value < "50" Then
        Cancel = True
        Target.Value = "50"
        Else
        Cancel = False
        
        End If
    End If
    
    Set UnionRange2 = Union(Range("J3:U3,J6:U6,J9:U9,J12:U12,J15:U15,J18:U18,J21:U21,J24:U24,J27:U27"), _
               Range("J30:K30,J33:K33,J36:K36,J39:K39,J42:K42,J45:K45,J48:K48"), _
               Range("J51:K51,J54:K54,J57:K57,J60:K60,J63:K63,J66:K66,J69:K69"), _
               Range("J72:K72,J75:K75,J78:K78,J81:K81,J84:K84,J87:K87,J90:K90"), _
               Range("J93:K93,J96:K96,J99:K99,J102:K102,J105:K105,J108:K108,J111:K111"), _
               Range("J114:K114,J117:K117,J120:K120,J123:K123,J126:K126,J129:K129,J132:K132"), _
               Range("J135:K135,J138:K138,J141:K141,J144:K144,J147:K147,J150:K150"))

    If Not Intersect(Target, UnionRange2) Is Nothing Then
        If Target.Value >= "20" And Target.Value < "25" Then
        Cancel = True
        Target.Value = "25"
        Else
        Cancel = False
        
        End If
    End If
 
    
    Set UnionRange3 = Union(Range("V5,V8,V11,V14,V17,V20,V23,V26,V29"), _
               Range("V32,V35,V38,V41,V44,V47,V50"), _
               Range("V53,V56,V59,V62,V65,V68,V71"), _
               Range("V74,V77,V80,V83,V86,V89,V92"))

    If Not Intersect(Target, UnionRange3) Is Nothing Then
        If Target.Value >= "1095" And Target.Value < "1105" Then
            Cancel = True
            Target.Value = "1105"
        ElseIf Target.Value >= "1343" And Target.Value < "1360" Then
            Cancel = True
            Target.Value = "1360"
        ElseIf Target.Value >= "1513" And Target.Value < "1530" Then
            Cancel = True
            Target.Value = "1530"
        Else
            Cancel = False
       End If
    End If
   End Sub
       

عدل مدى الأرقام كما تحب

[أبو أية]

 

أخى الحبيب والغالى / أ. ياسر

أُشهدُ الله أنى أحبك فى الله... أرجوا من الله أن يجمعنى بك تحت ظله يوم لا ظل إلا ظله..

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

بارك الله فيك فقد كانت إجابتك هى الإجابة الشافية والوافية..

فقط لى طلب أخير ألا وهو أن تدلنى على بداية الطريق لتعلم الـ VBA من البداية فأى الطرق أسلك وأى الأماكن أجد فيها ما يعيننى على تعلم هذه البرمجة.

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

تم تعديل أبريل 3, 2015 بواسطه أبو أية

[ياسر خليل أبو البراء]

أخي الحبيب الغالي أبو آية

مشكور على إطرائك الجميل

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

بالنسبة لطلبك عن تعلم VBA فيوجد باب يمكن فتحه كبداية ..

http://www.officena.net/ib/index.php?showtopic=56941

ومتابعة موضوعات المنتدى هي السبيل للتعلم ..

تابع وواصل من غير فواصل ..وإن شاء الله تفيد وتستفيد

[ا بو سليمان]

أخي الحبيب الغالي أبو آية

مشكور على إطرائك الجميل

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

بالنسبة لطلبك عن تعلم VBA فيوجد باب يمكن فتحه كبداية ..

http://www.officena.net/ib/index.php?showtopic=56941

ومتابعة موضوعات المنتدى هي السبيل للتعلم ..

تابع وواصل من غير فواصل ..وإن شاء الله تفيد وتستفيد

ايه الرابط  يا اخ ياسر 

 

انا اتصدع راس عندما شفت الموضوع 

 

ياااااااااااااااااااااارايق  

 

كيف يتم صياغته من خلال الامثله  على ملفات اكسل