البحث في الموقع

تواجهني كثير مشكلة وجود مسافات زائدة فى الكتابة سواء عند الكتابة او عند استلام ملفات من الغير و اغلب هذه المسافات تتمثل فيما يلي: - مسافة زائدة بعد حرف الواو - مسافة زائدة قبل الفاصلة - مسافتين متتاليتين مما يضيع الكثير من الوقت فى تصحيح الوضع لذا استخدم حاليا هذا الكود للتغلب على هذه المشكلة. نظرا لكثرة استخدامه بالنسبة لي ، ووجد انه من الافضل اضافته الي شريط الوصول السريع quick access toolbar و ذلك عن طريق ما يلي: 1- نقل الكود الي الوحدات النمطية العامة الضغط بالزر الايمن على القائمة او شريط القوائم ثم اختيار Customize quick access bar و من ثم اختيار ماكرو من القائمة و اضافته ، ثم تغيير اسم الايقونة و شكلها للسهولة Sub ArabicSpace() ' حذف المسافة قبل الفاصبة Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = " ، " .Replacement.Text = "، " .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchKashida = False .MatchDiacritics = False .MatchAlefHamza = False .MatchControl = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll ' حذف المسافة قبل حرف الواو Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = " و " .Replacement.Text = " و" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchKashida = False .MatchDiacritics = False .MatchAlefHamza = False .MatchControl = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll ' استبدال المسافتين الزائدتين بواحدة فقط Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = " " .Replacement.Text = " " .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchKashida = False .MatchDiacritics = False .MatchAlefHamza = False .MatchControl = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll End Sub