الضغط على شكل تلقائى برمجيا أو programmatically click on a shape

[مختار حسين محمود]

السلام عليكم و رحمة الله و بركاته  اخوانى و أحبابى فى أوفيسنا

اليوم باذن الله تعالى أعرض عليكم  تعليمة برمجية  صغيرة من سطر واحد

تمكنك هذه التعليمة من الضغط على أى شكل تلقائى بمعلومية اسمه .

مثال : اذا كان لديك شكلا تلقائيا اسمه Picture 1  كيف تضغط عليه برمجيا لا يدويا  

يمكن تنفيذ ذلك من خلال هذه التعليمة :

Sub clickonashape()
    Application.Run ActiveSheet.Shapes("Picture 1").OnAction   
End Sub

ممارسة الضغط على الشكل Picture 1  لن تشعر به الا اذا ربطت هذا الشكل بكود معين يؤكد لك أنه تم ضغطه

لنربط الشكل بالكود التالى مثلا :

Sub xxx()
    MsgBox "Hi Officna"
End Sub

جرب تشغيل الكود الأول

ستجد أن الكود الثانى اشتغل و ظهرت الرسالة  (  Hi Officna )     

 

تطبيق على الكود السابق : اضافة شكل تلقائى لتشغيل كود مباشرة دون ربطه يدويا

فى الكود التالى تم استثمار التعليمة السابقة و لكن بشكل مختلف :

يتم اضافة شكل تلقائي فى مكان محدد بالشيت و له بعض الخصائص  : من ضمن هذه الخصائص : أن يكون الشكل مربوطا بكود موجود مسبقا 

Sub addshpjoinedwithcode()
Dim shp As Shape
' اضافة الشكل فى المكان المحدد
Set shp = ActiveSheet.Shapes.AddShape(msoShapeSmileyFace, Left:=ThisWorkbook.Application.Range("E5").Left + 10, Top:=ThisWorkbook.Application.Range("E5").Top + 2, Width:=100, Height:=100)

' اضافة بعض الخصائص للشكل المضاف
With shp
  .Name = "SmileyFace"
  .Fill.ForeColor.RGB = RGB(255, 192, 0)        ' لون الشكل
  .Line.ForeColor.RGB = RGB(0, 176, 240)         ' لون الخط
  .Adjustments.Item(1) = -2              ' الشكل يبدو عابسا
  .OnAction = "xxx"          ' السطر الرئيسى : فى حالة ضغط الشكل يعمل الكود المحدد
End With

End Sub

يعنى باختصار  يلا  يظهر الشكل  تقدر  تدوس عليه ليعمل الكود  التالى :  xxx

Sub xxx()
Application.ScreenUpdating = False

With ActiveSheet.Shapes("SmileyFace")
     .Fill.ForeColor.RGB = RGB(146, 208, 80)  ' لون الشكل الجديد
     .Line.ForeColor.RGB = RGB(192, 0, 0)      ' لون الخط الجديد
     .Adjustments.Item(1) = 1                 ' الشكل يبدو ضاحكا
End With

Application.ScreenUpdating = True

MsgBox "Hi Officna"

End Sub

المرفقات :

programmatically add shape , join it with specific code.rar

programmatically click on a shape.rar

أتمنى أن يكون الموضوع خفيفا و مفيدا  لكم فى أكوادكم و برامجكم

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

تم تعديل يناير 23, 2016 بواسطه مختار حسين محمود

[نايف - م]

يا أخوة

أنا لم أستطع تحميل الملف الثاني

حدا عندو المشكلة نفسها أو بس أنا

[مختار حسين محمود]

أستاذ نايف جرب  التحميل مرة أخرى

عذرا فقد حدث خطأ أثناء اضافة الموضوع

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

أخي الغالي مختار

صحيح بتغطس بس بتطلع لنا بجواهر ودرر يا أحلى غطاس ..

تصدق إمبارح بس لسه عارف المعلومة دي بتاعة Application.Run .. لما شفت الموضوع عجبني توارد الأفكار لأني كنت بفكر أعمل موضوع مشابه ، بس طبعاً مكانش هيكون متميز زي موضوعك

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

 

[ياسر العربى]

الموضوع شكله ضاحكا  واللي يعدي وميحطش اعجاب يبقي عابسا

احلى لايك

[مختار حسين محمود]

أستاذى الغالى ياسر خليل

بارك الله فيك و جزاك كل خير  ... شوفت الغطس بيعمل ايه يا أحلى مستر

  أحاول أن أقدم لكم شيئا و لو ضئيلا  مما تقدمه لاخوانك أستاذنا الغالى

أخى الغالى ياسر العربى أولا  مبروووووووووووك على انضمامك لفريق الموقع  ومشكور على مرورك الجميل

 

 

[محمد حسن المحمد]

السلام عليكم أستاذي الحبيب مختار 

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

[مختار حسين محمود]

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

أشكرك من كل قلبى على دعمك وتشجيعك لى  كما أشكرك على مرورك الرائع  جزاكم الله خيرا ..