تحريك الـ WordArt

[زياد علي]

بسم الله

والصلاة والسلام على رسول

السلام عليكم

في برنامج الاكسيل يمكن أن يتم تحريك النصوص إلى حد معين. والمثال المرفق يوضح ذلك بشكل بسيط ،،،

أرحب بأي إضافة جديدة للمشاركة ،،،،

واتمنى أن يكون الموضوع مفيداً

WordArt تحريك الـ.rar

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

السلام عليكم

بارك الله فيك أخ زياد ... بصراحة والصراحة راحة وإنت أستاذ ومتمكن ورائع

أيو والله راااااااااااااااااائع

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

http://www.officena.net/ib/index.php?showtopic=30770

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

أخوك في الله أبو البراء

[ابو القبطان]

حبيب الكل : زياد علي

الموضوع جميل جدا زي اللي عمله ، بس ياريت تقولنا نغير اي ارقام في الكود لنبطئ الحركة او لنزيد من السرعة وكيفية دوران الكلمة حول المركز .. باختصار اشرح الكود .. يا ابو الجود

اخوك : حسن علي

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

السلام عليكم

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

حركات جميلة جدا

تقبل تحياتي وشكري

[احمد فضيله]

بارك الله فيك

[احمد فضيله]

يا ريت بالله عليك

شرح مبسط للكود

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

[زياد علي]

السلام عليكم

اخي الحبيب ياسر خليل

جزاك الله عني خير الجزاء ،،،

بهذه الكلمات الطيبة ،،،

والله يجبر بخاطرك ،،،

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

وإذا حضر الماء بطل التيمم

مودتي وتقديري

[زياد علي]

السلام عليكم

اخي الحبيب واستاذي خبور خير

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

مودتي واحترامي

[زياد علي]

السلام عليكم

اخي الحبيب NEW4A

اخي الحبيب HaNcOcK

جزاكم الله عني كل خير ،،،

وتشرفت بمروركم العطر ،،،

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

أولاً : لكي يتم فهم الكود يجب أن يتم شرح الأمر FOR……NEXT :

الأمر FOR……NEXT

الوظيفة :

يستخدم هذا الأمر لتكرار مجموعة من الأوامر عدة مرات بدلاً من إعادة كتابتها وتعتمد الفكرة الأساسية على تخصيص متغير لحساب عدد مرات التكرار ، أي أن ذلك المتغير يصبح عداد لمرات التكرار ، حيث يبدأ المتغير بقيمة ما ويتنهي بقيمة آخرى ، ويزداد – أو ينقص- بمعدل ثابت .

الصيغة العامة :

FOR  المتغير   = قيمة البداية   TO  قيمة النهاية  STEP  مقدار الزيادة أو النقصان 


مجموعة الأوامر التي سيتم تكرارها


NEXT المتغير

وفي مثالنا هذا :

For i = 1 To 80

        Selection.ShapeRange.TextEffect.Tracking = m

        m = m + 0.125

       DoEvents

    Next i

سيتم تكرار مجموعة الأوامر المحصورة بين جملة بداية التكرار (FOR) وجملة نهاية التكرار (NEXT) مقدار 80 مرة، وقد تم استخدام متغير باسم i ، وهو يعتبر بمثابة عداد لمرات التكرار ، حيث بدأ المتغير بالقيمة 1 وفي كل مرة تنفذ فيها مجموعة الأوامر يزداد المتغير بقيمة مقدارها 1 إلى أن يصل إلى قيمة النهاية (وهي في مثالنا هذا 80 ) حيث يخرج البرنامج من الحلقة التكرارية وينفذ الأوامر التي تلي أمر نهاية التكرار (NEXT) ، وتجدر الإشارة هنا إلى أن أمر –STEP الموجود في جملة بداية التكرار –FOR يمكن الأستغناء عنه إذا كان مقدار الزيادة المطلوب هو 1 ، وهي القيمة الافتراضية للبرنامج . =================================================================================================== ثانياً شرح الكود :

Option Explicit

Dim oldcell As Range

' حجز متغير من النوع كائن نطاق

Dim m As Variant

' الإعلان عن متغير عام يقوم بحساب قيمة حركة النص

Dim i As Variant

'الإعلان عن متغير عام يقوم بوظيفة عداد لمرات تكرار الإجراء



Sub StartDemo()


    On Error Resume Next

    Set oldcell = ActiveCell

  'تخصيص النطاق المعلن عنه ليحل محل الخلايا النشطة

      ActiveSheet.Shapes("WordArt 1").Select

  'لاختيار النص الأول

    m = 1

     'قيمة المتغير الذي تم الإعلان عنه ليقوم بعملية الاحتساب

    For i = 1 To 80

     'الدخول في الحلقة التكرارية حيث سيقوم بتفيذ الأمر المطلوب 80 مرة

        Selection.ShapeRange.TextEffect.Tracking = m

         'تخصيص واستدعاء لللإجراء المطلوب للمتغير المعلن عنه

        m = m + 0.125

         'لتنفيذ مقدار الزيادة والنقص وإعطاء نوع التأثير المطلوب وممكن من هنا أن تقوم بتعديل القيمة جرب مثلاً

              '.5

       DoEvents

   'حتى نتمكن من مشاهدة الحدث وهو الحركة المطلوبة وفي حالة عدم وجود هذه الجملة فلن يتحرك النص

      'الباقي تكرار لما سبق ولكن بطريقة عكسية حتى يقوم النص بالدوران

    Next i

    For i = 80 To 1 Step -1

       Selection.ShapeRange.TextEffect.Tracking = m

       m = m - 0.125

       DoEvents

    Next i


    Selection.ShapeRange.TextEffect.Tracking = 1

   'حتى يرجع النص لما كان عليه

   'نفس المطبق على النص الأول يطبق على الثاني

    ActiveSheet.Shapes("WordArt 2").Select

    For i = 1 To 8

        Selection.ShapeRange.IncrementRotation 45#

        DoEvents

    Next i


    Selection.ShapeRange.TextEffect.Tracking = 1


    ActiveSheet.Shapes("WordArt 2").Select

    m = 1

    For i = 1 To 80

        Selection.ShapeRange.TextEffect.Tracking = m

        m = m + 0.25

        DoEvents

    Next i

    For i = 80 To 1 Step -1

        Selection.ShapeRange.TextEffect.Tracking = m

        m = m - 0.25

        DoEvents

    Next i


    Selection.ShapeRange.TextEffect.Tracking = 1


    ActiveSheet.Shapes("WordArt 2").Select

    For i = 1 To 16

        Selection.ShapeRange.IncrementRotation 45#

        DoEvents

    Next i


    Selection.ShapeRange.TextEffect.Tracking = 1


    oldcell.Select


End Sub

أتمنى أن يكون الشرح مفيد وواضح ،،،

شاكراً للجميع حسن الأهتمام

مودتي وتقديري للجميع

[خالد القدس]

السلام عليكم

إبداع وتميز

سلمت يمينك أستاذ زياد

[احمد فضيله]

و عليكم السلام

اخي الحبيب ziad ali

جزاكم الله عني و عن كل من بالمنتدي كل خير

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

وفقك الله

[زياد علي]

السلام عليكم

اخي الحبيب خالد القدس ،،،

اخي الحبيب HaNcOcK

أنه لشرف لي مروركم الكريم على مواضيعنا المتواضعة بالمنتدى ،،،

شاكراً لكم كلامكم الطيب ،،، الذي لايخرج إلا من القلوب الطيبة ،،،

مع خالص مودتي وتقديري