هل يمكن عمل ماكرو لإلغاء أزرار الماكرو الموجودة في نطاق صفوف محددة

[عاطف عبد العليم محمد]

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

 

لدي عدة أزرار لأكثر من ماكرو في صفوف محددة مثلا الصفوف من 3 الى 5  هل يمكن عمل ماكرو يبحث عن كل زر ويلغيه في هذه الصفوف

 

وشكرا للاساتذة الكرام

[عاطف عبد العليم محمد]

ألفت هذا الماكرو ولكنه لا يعمل المطلوب

 

 ("For Each Button In Rows("454:460

    Button.Select

    Selection.Cut

    Next Button

هل من معلم يعلمنا ؟

 

ولزيادة الإيضاح  وربما ييسر ذلك الحل

 الأزرار الموجودة هي لعدد 2 ماكرو فقط ولكن زر  كل ماكرو مكرر ربما 40 مرة والمطلوب الغاء الازرار فقط وليس الماكرو

 

وفق  الله الجميع لما يحب ويرضى

[حمادة عمر]

 السلام عليكم

الاخ الكريم

برجاء ارفاق ملف لتوضيح المطلوب افضل من ذلك

وان شاء الله ستجد العون من الجميع

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

[عاطف عبد العليم محمد]

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

 استاذنا الكريم

مرفق ملف للتوضيح

وفقكم الله ، وجزاكم الله خيرا 

أزرار مطلوب الغائها.rar

[خالد الشاعر]

استاذ عاطف

 

مرفق ملف به زر الغاء الزرار

 

ارجو ان اكون وفقت فى تنفيذ طلبك

 

ازرار.rar

[رجب جاويش]

السلام عليكم

ولائراء الموضوع هذا كود آخر

Sub ragab()
Dim shp As Shape
For Each shp In ActiveSheet.Shapes
If shp.AutoShapeType = -2 And shp.Top > 120 Then shp.Delete
Next
End Sub

أزرار مطلوب الغائها.rar

[خالد الشاعر]

استاذ رجب

 

عمل رائع تسلم ايدك

 

لى استفسار لو سمحت فى هذا السطر

 

If shp.AutoShapeType = -2 And shp.Top > 120 Then shp.Delete

 

ماذا تعنى هذه الارقام

 

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

[رجب جاويش]

أخى الفاضل / خالد

الرقم -2 يدل على نوع الشكل ( الزر ) المراد حذفه

أما الرقم 120 يعنى أنه اذا كان  TOP ( المسافة من الحافة العلوية للشكل الى حافة التطبيق )   للشكل أكبر من 120 يتم حذفه

[عاطف عبد العليم محمد]

الأخ / خالد الشاعر

 

جزاك الله خيرا  ولكن المقصود كان الغاء كل الأزرار  حسب اتجاه السهم في المثال

وفقك الله

[عاطف عبد العليم محمد]

 

 

استاذنا  رجب جاويش 

 وفقك الله وجزاك الله خيرا وبردك على الأخ خالد الشاعر وضحت الأمور اكثر ولكن 

في الملف الأصلي عندي الغيت الصفوف التي بها الأزرار فبقيت الأزرار وارتفاعها صفر 

في شرحكم قلتم 

 

أما الرقم 120 يعنى أنه اذا كان  TOP ( المسافة من الحافة العلوية للشكل الى حافة التطبيق )   للشكل أكبر من 120 يتم حذفه

 

فأنا وضعت  =0 بدلا من اكبر من 120  ولم ينفذ الالغاء  

فما معنى حافة التطبيق  واظنها لا تعني الحافة السفلية 

وأفدنا عن التعديل اللازم  بارك الله فيكم

وبالمناسبة هل تعرف الشيخ الدكتور سعد جاويش  

[رجب جاويش]

أخى الفاضل

الصورة التالية توضح لك معنى TOP

 

[رجب جاويش]

أما بالنسبة لـ

الشيخ الدكتور سعد جاويش

فأنا لم أحظ بشرف معرفته

[حمادة عمر]

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

استاذنا العملاق الفارس

رجب جاويش

[رجب جاويش]

أخى الحبيب / جمادة عمر

جزاك الله كل خير على هذا المرور العطر والكلمات الطيبة

[عاطف عبد العليم محمد]

كما قال استاذي حمادة عمر 

 

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

استاذنا العملاق الفارس

رجب جاويش

 

ولكن هل يوجد كود لالغاء الأزرار حسب أرتفاع الزر نفسه   حيث  في الملف الأصلي عندي الغيت الصفوف التي بها الأزرار فبقيت الأزرار وارتفاعها صفر  ومن الصعب قياس top  عندي لأن الأزرار  بعد الصف 450  والصفوف مختلفة الارتفاعات 

إلا إذا  وحدت ارتفاع الصفوف  ثم ضربت في 450  ثم بعد الالغاء أعيد الصفوف كما كانت وستكون عملية شاقة 

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

تم تعديل يونيو 17, 2013 بواسطه atef0977

[رجب جاويش]

أخى الفاضل

أنا اعتمدت على خاصية الـ TOP  للشكل نفسة وليس للصفوف

حيث حددت قيمة أقل من الـ TOP  لأقرب شكل الى حافة المستند ( من الأشكال المراد حذفها )

ثم وضعت السطر داخل الكود يقول أنه اذا زاد الـ TOP  عن هذا الرقم يتم الحذف

[عاطف عبد العليم محمد]

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

هل في طريقة أخرى لقياس top  غير التي استنتجتها  وهي عدد الصفوف × ارتفاع الصف 

[رجب جاويش]

أخى الفاضل

ولا يهمك أنا معك لن أمل حتى تصل الى ما تريد

 

نفذ الكود التالى

Sub ragab()
Range("A1") = ActiveCell.Top
End Sub

قم بالوقوف على أى خليه تريدها بالماوس ( المراد معرفة الـ TOP لها ) ونفذ الكود السابق

سوف تجد مكتوب فى الخليه A1  قيمة الـ TOP  الخاصة بالخلية المحددة

تم تعديل يونيو 17, 2013 بواسطه رجب جاويش

[عبدالله باقشير]

السلام عليكم

بعد ما تحذف الصفوف

استخدم الكود هذا لحذف الازرار التي ارتفاعها صفر

Sub ragab()
Dim shp As Shape
For Each shp In ActiveSheet.Shapes
If  shp.Height = 0 Then shp.Delete
Next
End Sub

تحياتي

[عاطف عبد العليم محمد]

 استاذي الفاضل  رجب جاويش 

بارك الله فيك  وجزاك الله خيرا  

 

وبالماكرو الأخير  متاكد أنني به ساصل لما اريد   

 

اسال الله ان يجعل ما تقدمه في هذا المنتدي صدقة جارية لك

بارك الله فيك  وجزاك الله خيرا  

[عاطف عبد العليم محمد]

 سعادة المدير عبدالله باقشير

 

جزاك الله خيرا  ويشرفني أنك تفضلت بالمرور واضافة حل آخر  رائع  

بارك الله فيك  وجزاك الله خيرا  

 

اسال الله ان يجعل ما تقدمه في هذا المنتدي صدقة جارية لك

 

بارك الله فيك  وجزاك الله خيرا  

[رجب جاويش]

أخى الفاضل / عاطف

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