أبو محمد عباس قام بنشر ديسمبر 6, 2014 مشاركة قام بنشر ديسمبر 6, 2014 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 اذا امكن اضافة رسالة تحذيرية تكون اما تنفيذ امر المسح او الغاء امر المسح لربما ضغطت على المسح سهوا ؟؟!! جزاكم الله خيرا رابط هذا التعليق شارك More sharing options...
محمود_الشريف قام بنشر ديسمبر 6, 2014 مشاركة قام بنشر ديسمبر 6, 2014 أخى فى الله الأستاذ الكبير // أبو محمد عباس ضع هذه الجزئية قبل نهاية الكود If MsgBox("أبو محمد عباس", 36, "هل تريد تصفير الرصد ؟") = vbNo Then Cancel = True End If وتقبل منى وافر الاحترام والتقدير 1 رابط هذا التعليق شارك More sharing options...
أبو محمد عباس قام بنشر ديسمبر 6, 2014 الكاتب مشاركة قام بنشر ديسمبر 6, 2014 (معدل) السلام عليكم ورحمة الله وبركاته الاخ الحبيب الاستاذ محمود الشريف جزاك الله خيرا اضافة رائعة للكود لكن اعتقد كما جربت الكود بعد الاضافة تظهر الرسالة لكن اذا اردت عدم تنفيذ الكود في اختيار زر (no) كذلك ينفذ المسح ارجو تعديل الاضافة لتوقف عمل الكود عند اختيار (no) وعدم المسح تقبل فائق احترامي وتقديري تم تعديل ديسمبر 6, 2014 بواسطه أبو محمد عباس رابط هذا التعليق شارك More sharing options...
Yasser Fathi Albanna قام بنشر ديسمبر 6, 2014 مشاركة قام بنشر ديسمبر 6, 2014 أخى أ / محمود الشريف سلمت يداك وهذا تطبيق على الكود + إضافة حضرتك على كود الأستاذ القدير ياسر خليل حفظه الله تطبيق كود تصفير الرصيد.rar 1 رابط هذا التعليق شارك More sharing options...
أبو محمد عباس قام بنشر ديسمبر 6, 2014 الكاتب مشاركة قام بنشر ديسمبر 6, 2014 السلام عليكم ورحمة الله وبركاته الاستاذ المهندس ياسر فتحي جزاك الله خيرا اخي العزيز لازالت المشكله كما نوهت على مشاركة الاستاذ محمود الشريف جزاه الله خيرا الكود ينفذ المسح حتى لو تم اختيار زر (no ) بارك بكم واعطاكم الصحة والعافية رابط هذا التعليق شارك More sharing options...
أبو محمد عباس قام بنشر ديسمبر 6, 2014 الكاتب مشاركة قام بنشر ديسمبر 6, 2014 (معدل) السلام عليكم ورحمة الله وبركاته الاساتذة الكرام والاخوة الاعزاء جزاكم الله خيرا قمت بتعديل بسيط على الاضافة التي ارسلها الاستاذ محمود الشريف بارك الله فيه لكي يعمل الكود بالشكل الصحيح وهو تنفيذ الامر عند اختيار (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 بواسطه أبو محمد عباس 2 رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر ديسمبر 6, 2014 مشاركة قام بنشر ديسمبر 6, 2014 جيت متأخر ..كالعادة المهم الحمد لله اتحلت المشكلة البسيطة .. دا دليل إنك مش متابع جيد للحلقات أستاذ أبو محمد عباس آخر حلقة شرحنا فيها النقطة دي .. المهم الحمد لله إنك وصلت للحل تقبل تحياتي 2 رابط هذا التعليق شارك More sharing options...
أبو محمد عباس قام بنشر ديسمبر 6, 2014 الكاتب مشاركة قام بنشر ديسمبر 6, 2014 السلام عليكم ورحمة الله وبركاته الاستاذ الفاضل والاخ الحبيب ابو البراء بارك الله فيكم وجزاكم الله خيرا انا متابع لاعمالكم وشرحكم لكن الخبرة قليله ويحتاج الى تراكم معلومات الرسالة بسيطة وعملتها قبل ان ابعث بالطلب لكن التنفيذ وعدم التنفيذ اتعبني وخاصة المتغيرات لكن بعد اجابة الاستاذ محمود الشريف جزاه الله خيرا استطعت ان اخذ المعلومة التي استفيد منها بتنفيذ الامر والحمد لله والشكرعلى كل حال تقبلوا فائق احترامي وتقديري 2 رابط هذا التعليق شارك More sharing options...
محمود_الشريف قام بنشر ديسمبر 6, 2014 مشاركة قام بنشر ديسمبر 6, 2014 أخى فى الله الأستاذ الكبير // أبو محمد عباس نحمد الله عز وجل أنكم توصلتم للإجابه على استفساركم والشكر موصول للأستاذ // القدير أبو البراء (( ياسر خليل )) لسلسله الدروس الشيقة والمفيدة لكل طالب علم كذلك الشكر موصول للمهندس // ياسر فتحى البنا على محاولته وتقبلوا منى جميعا وافر الاحترام والتقدير 2 رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
من فضلك سجل دخول لتتمكن من التعليق
ستتمكن من اضافه تعليقات بعد التسجيل
سجل دخولك الان