رسالة تحذير لتنفيذ امر الكود بالمسح او عدم تنفيذه

[أبو محمد عباس]

Sub تصفير_الرصد()
    Dim UnionRange As Range
    Application.ScreenUpdating = False
    Set UnionRange = Union(Range("F6:H55,J6:L55,O6:O55,R6:T55,V6:X55,AA6:AA55,AD6:AF55,AH6:AJ55,AM6:AM55,AP6:AR55"), _
                           Range("AT6:AV55,AY6:AY55,BB6:BD55,BF6:BH55,BK6:BK55,BN6:BP55,BR6:BT55,BW6:BW55,BZ6:CB55,CD6:CF55"), _
                           Range("CU6:CU55,CP6:CR55,CL6:CN55,CI6:CI55,F206:H255,J206:L255,O206:O255,R206:T255,V206:X255,AA206:AA255"), _
                           Range("AD206:AF255,AH206:AJ255,AM206:AM255,AP206:AR255,AT206:AV255,AY206:AY255,BB206:BD255,BF206:BH255,BK206:BK255,BN206:BP255"), _
                           Range("BR206:BT255,BW206:BW255,BZ206:CB255,CD206:CF255,CU206:CU255,CP206:CR255,CL206:CN255,CI206:CI255,F406:H455,J406:L455"), _
                           Range("O406:O455,R406:T455,V406:X455,AA406:AA455,AD406:AF455,AH406:AJ455,AM406:AM455,AP406:AR455,AT406:AV455,AY406:AY455"), _
                           Range("BB406:BD455,BF406:BH455,BK406:BK455,BN406:BP455,BR406:BT455,BW406:BW455,BZ406:CB455,CD406:CF455,CU406:CU455,CP406:CR455"), _
                           Range("CL406:CN455,CI406:CI455,F606:H655,J606:L655,O606:O655,R606:T655,V606:X655,AA606:AA655,AD606:AF655,AH606:AJ655"), _
                           Range("AM606:AM655,AP606:AR655,AT606:AV655,AY606:AY655,BB606:BD655,BF606:BH655,BK606:BK655,BN606:BP655"), _
                           Range("BR606:BT655,BW606:BW655,BZ606:CB655,CD606:CF655,CU606:CU655,CP606:CR655,CL606:CN655,CI606:CI655"))
    UnionRange.ClearContents
    Application.ScreenUpdating = True
    Range("F1").Select
End Sub

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

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

للاستاذ الفاضل ابو البراء جزاه الله خيرا  في هذا الموضوعhttp://www.officena.net/ib/index.php?showtopic=56943#entry361305

اذا امكن اضافة رسالة تحذيرية تكون اما تنفيذ امر المسح او الغاء امر المسح

لربما ضغطت على المسح سهوا ؟؟!!

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

 

 

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

أخى فى الله

الأستاذ الكبير // أبو محمد عباس

ضع هذه الجزئية قبل نهاية الكود

 

    If MsgBox("أبو محمد عباس", 36, "هل تريد تصفير الرصد ؟") = vbNo Then
    Cancel = True
    End If

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

[أبو محمد عباس]

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

الاخ الحبيب الاستاذ محمود الشريف جزاك الله خيرا

اضافة رائعة للكود لكن اعتقد كما جربت الكود بعد الاضافة تظهر الرسالة

لكن اذا اردت عدم تنفيذ الكود في اختيار زر (no) كذلك ينفذ المسح

ارجو تعديل الاضافة لتوقف عمل الكود عند اختيار (no) وعدم المسح

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

 

 

تم تعديل ديسمبر 6, 2014 بواسطه أبو محمد عباس

[Yasser Fathi Albanna]

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

سلمت يداك

وهذا تطبيق على الكود + إضافة حضرتك

على كود الأستاذ القدير ياسر خليل حفظه الله

تطبيق كود تصفير الرصيد.rar

[أبو محمد عباس]

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

الاستاذ المهندس ياسر فتحي جزاك الله خيرا

اخي العزيز لازالت المشكله كما نوهت على مشاركة الاستاذ محمود الشريف جزاه الله خيرا

الكود ينفذ المسح حتى لو تم اختيار زر (no )

بارك بكم  واعطاكم الصحة والعافية

[أبو محمد عباس]

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

الاساتذة الكرام والاخوة الاعزاء جزاكم الله خيرا

قمت بتعديل  بسيط على الاضافة التي ارسلها الاستاذ محمود الشريف بارك الله فيه

لكي يعمل الكود بالشكل الصحيح وهو تنفيذ الامر عند اختيار (YES) وايقاف التنفيذ عند اختيار (NO)

وفقكم الله جميعا واعطاكم الصحة والعافية

Sub مسح_الرصد()
    Dim UnionRange As Range
    Application.ScreenUpdating = False
    a = MsgBox("أبو محمد عباس", 36, "هل تريد تصفير الرصد ؟")
    If a = vbYes Then
    With ActiveSheet
    Set UnionRange = Union(Range("F6:H55,J6:L55,O6:O55,R6:T55,V6:X55,AA6:AA55,AD6:AF55,AH6:AJ55,AM6:AM55,AP6:AR55"), _
                           Range("AT6:AV55,AY6:AY55,BB6:BD55,BF6:BH55,BK6:BK55,BN6:BP55,BR6:BT55,BW6:BW55,BZ6:CB55,CD6:CF55"), _
                           Range("CU6:CU55,CP6:CR55,CL6:CN55,CI6:CI55,F206:H255,J206:L255,O206:O255,R206:T255,V206:X255,AA206:AA255"), _
                           Range("AD206:AF255,AH206:AJ255,AM206:AM255,AP206:AR255,AT206:AV255,AY206:AY255,BB206:BD255,BF206:BH255,BK206:BK255,BN206:BP255"), _
                           Range("BR206:BT255,BW206:BW255,BZ206:CB255,CD206:CF255,CU206:CU255,CP206:CR255,CL206:CN255,CI206:CI255,F406:H455,J406:L455"), _
                           Range("O406:O455,R406:T455,V406:X455,AA406:AA455,AD406:AF455,AH406:AJ455,AM406:AM455,AP406:AR455,AT406:AV455,AY406:AY455"), _
                           Range("BB406:BD455,BF406:BH455,BK406:BK455,BN406:BP455,BR406:BT455,BW406:BW455,BZ406:CB455,CD406:CF455,CU406:CU455,CP406:CR455"), _
                           Range("CL406:CN455,CI406:CI455,F606:H655,J606:L655,O606:O655,R606:T655,V606:X655,AA606:AA655,AD606:AF655,AH606:AJ655"), _
                           Range("AM606:AM655,AP606:AR655,AT606:AV655,AY606:AY655,BB606:BD655,BF606:BH655,BK606:BK655,BN606:BP655"), _
                           Range("BR606:BT655,BW606:BW655,BZ606:CB655,CD606:CF655,CU606:CU655,CP606:CR655,CL606:CN655,CI606:CI655"))
    UnionRange.ClearContents
        End With
    Cancel = False
    End If
    Application.ScreenUpdating = True
    Range("F1").Select
End Sub

تعديل الاضافة على كود المسح.rar

تم تعديل ديسمبر 6, 2014 بواسطه أبو محمد عباس

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

جيت متأخر ..كالعادة

المهم الحمد لله اتحلت المشكلة البسيطة .. دا دليل إنك مش متابع جيد للحلقات أستاذ أبو محمد عباس

آخر حلقة شرحنا فيها النقطة دي ..

المهم الحمد لله إنك وصلت للحل تقبل تحياتي

[أبو محمد عباس]

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

الاستاذ الفاضل والاخ الحبيب ابو البراء بارك الله فيكم وجزاكم الله خيرا

انا متابع لاعمالكم وشرحكم لكن الخبرة قليله ويحتاج الى تراكم معلومات

الرسالة بسيطة وعملتها قبل ان ابعث بالطلب 

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

استطعت ان اخذ المعلومة التي استفيد منها بتنفيذ الامر

والحمد لله والشكرعلى كل حال

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

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

أخى فى الله

الأستاذ الكبير // أبو محمد عباس

نحمد الله عز وجل أنكم توصلتم للإجابه على استفساركم

والشكر موصول للأستاذ // القدير أبو البراء (( ياسر خليل ))

لسلسله الدروس الشيقة والمفيدة لكل طالب علم

كذلك الشكر موصول للمهندس // ياسر فتحى البنا على محاولته

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