ماكرو لاستبدال تنسيق خط حرف معين

المشكلة التي ظهرت مع بداية الوندوز 95 وحتى XP في الخطوط الافتراضية وأهمها جميعاً وأكثرها مشاكل هو أروعها لكتابة النصوص العربية Traditional Arabic ومن هذه المشاكل مثلاً:

1- زيادة طول الشرطة المذكورة في هذا السؤال

2- وجود بعض الزوائد أحياناً كثيرة في نهايات الأسطر والتي قد تشوه الحرف الأخير من السطر

3- عدم وضوح بعض الأحرف المركبة مثل حرف النون بعدها حرف الزاء مثل كلمة نزهة مثلاً.. حيث تبدو الكلمة وكأنها ترهة لتقارب نقطة النون مع نقطة الزاء

أما أفضل الحلول في رأيي - وقد جربت ذلك شخصياً - هو استبدال خط Traditional Arabic في الوندوز الحديث 95 فما فوق بخط Traditional Arabic من إصدار وندوز قديم 3.1 أو 3.11 وبذلك تختفي جميع المشاكل السابقة..

ملاحظة:

قد تجد بعض المشاكل البسيطة عند عمليات الاستبدال أو الاستبدال للكل خصوصاً للأقواس ( ) مع هذا الخط لكنها مشاكل طفيفة ولا تدعو للقلق ومن الممكن تداركها.. كما يمكنك العمل على النسخة الحالية من الخط Traditional Arabic وتثبيت خط Traditional Arabic من وندوز 3.11 قبل الطباعة ليخفي تلك العيوب..

الأخ ib338 :

أشكرك على هذه الإفادة ، وعلى الخط ، فهو حقا أقل عيوبا من خط Traditional Arabic الحالي، وإن كان يخيل لي أن الحالي أجمل .

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

والسؤال المطروح حول الماكرو لا زال باقيا .

ماكرو لتببببديل الفونت لكلمة معينة

Rem لتغيير الفونت لكلمة معينة

Sub replaceformat()
searchword = InputBox("Enter the word  to replace Format", "replace format of a word", "M")
Application.ScreenUpdating = True

nextword:
Selection.WholeStory
Mcount = Selection.Words.Count
     ' MsgBox mcount
   For I = 1 To Mcount

   With Selection.Words(I)
          Application.StatusBar = "Searching / Formating ...." & _
             Mcount & "       Please Wait......."
       If Searchit(.Text) = True Then
        .Font.Name = "Courier"
        .Font.Size = 14
        .Font.Bold = False
        .Font.Italic = False
       End If
        End With
   Next I

End Sub

Function Searchit(Myword)
Searchit = False
  If Trim(UCase(Myword)) = Trim(UCase(searchword)) Then
  Searchit = True
  End If
 End Function

هل يمكنني وضع زر في شريط الادوات او القوائم لتشغيل هذا الماكرو

حاولت عمل ذلك ولكنني لا اعرف الطريقة في الربط بينهما وهل يمكن ان يعتمد الماكرو في الوورد على حدث في المستند

وفقكم الله لكل خير

بالنقر بالزر الايمن علي شريط الايقونات

ثم

Customize

Command

Macros

اختار الماكرو و اسحبه الي شريط الايقونات

اذا كنت تريد استبدال تنسيف كلمة معينه فالورد عنده الحل بدون برمجه وبدون الدخول في الماكرو وهو استخدام بحث واستبدال فما عليك هو كتابة الكلمة المراد البحث عنها واستبدلها بالكلمة الذي تريد مع التنسيق الذي تريد

المطلوب كان استبدال الفونت لكلمة محددة و ليس الكلمة نفسها

حتى ولو كنت تريد تغيير تنسيق كلمة معينه فالحل هو انكت تذهب لمربع بحث واستبدال وتقوم في مربع البحث وتضع الكلمة التي تريد وفي مربع استبدل بـ ضع الموشر هناك واضغط على زر تنسيق ونسق بالشكل الذي تريد

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

شكرا علي المعلومة

و لم أكن أعرفها

و لكن هل كانت هذه الخاصية موجودة قبل ال XP

فان لم تكن فسيكون هذا الماكرو مازال مفيدا ;) لمن لديهم 2000 و 97 و أعتقد أنني قمت باعداده عندما كنت أستخدم 2000 ، و لا أدري ان كانت هذه الامكانية متاحة فى 2000 أم لا

و أيضا الحل عن طريق الكود فيه فوائد كثيرة أكثر تعقيدا يمكن اضافتها اليه علي عكس الحل المباشر

فمثلا علي سبيل المثال هنا تم تجاهل هل الكلمة Upper ام Lower باستخدام الدالة Upper فى المقارنة ( و هذا أيضا يمكن تحقيقه بدون الكود ;) ) و لكن بالكود يمكن اضافة بعد الاستثنائات بحسب حاجة المستخدم الذي يريد حالات خاصة مثل مثلا أن لا يتعدي عدد الحروف المستبدلة عدد معين

او بحسب الطلب ، فالمجال فى البرمجة مازال مفتوحا أكثر من الحلول المباشرة بكثييييييير جدا

أيضا هذا لا يغنينا عن استخدام الحل المباشر اذا أدي الغرض ، كما نصحت أنت

و إن لم يكن فسأتركه ليكون مثال علي البرمجة فى الوورد

و شكرا مرة ثانية علي المعلومة

اول شي اشكرك على التواصل واشكرك على المعلومات الجليلة التي تخدم بها من هم القليلين الخبره امثالي :D ولكن اريد ان افيدك ان الحركه التي ذكرت انا كانت موجوده في الاوفس 97 و 2000 وشكرا على تواصلك معنا

و لمن لم يري مكان تغيير الفورمات من مربع حوار الاستبدال فى 2000 أو 97

فليضغط علي زر more الموجود أسفل مربع الحوار

المثال السابق

changeformat_word.zip

آسف حيث غفلت عن هذا الموضوع كل هذه المدة

وجدت الغرض المطلوب في السؤال في الماكرو التالي

Selection.Find.ClearFormatting

    Selection.Find.Replacement.ClearFormatting

    With Selection.Find

        .Text = "هـ"

        .Replacement.Text = "هـ"

        .Replacement.Font.Name = "Arial"

        .Forward = True

        .Wrap = wdFindContinue

        .Format = True

    End With

    Selection.Find.Execute Replace:=wdReplaceAll