اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

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

قام بنشر

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



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

  • Like 1
قام بنشر (معدل)

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

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

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

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

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

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

 

 

تم تعديل بواسطه أبو محمد عباس
قام بنشر

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

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

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

الكود ينفذ المسح حتى لو تم اختيار زر (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

تم تعديل بواسطه أبو محمد عباس
  • Like 2
قام بنشر

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

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

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

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

  • Like 2
قام بنشر

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

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

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

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

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

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

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

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

  • Like 2
قام بنشر

أخى فى الله

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

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

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

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

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

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

  • Like 2

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