اذهب الي المحتوي
أوفيسنا

الردود الموصى بها

قام بنشر

تواجهني كثير مشكلة وجود مسافات زائدة فى الكتابة سواء عند الكتابة او عند استلام ملفات من الغير

و اغلب هذه المسافات تتمثل فيما يلي:

- مسافة زائدة بعد حرف الواو

- مسافة زائدة قبل الفاصلة

- مسافتين متتاليتين

مما يضيع الكثير من الوقت فى تصحيح الوضع

لذا استخدم حاليا هذا الكود للتغلب على هذه المشكلة.

 

نظرا لكثرة استخدامه بالنسبة لي ، ووجد انه من الافضل اضافته الي شريط الوصول السريع

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

 

  • Like 1
قام بنشر (معدل)

أشكرك أستاذ محمد على المعلومات القيِّمة،

حاولت نسخ الكود ووضعه بمكانه المحدد ظهرت مشكلة كما هو موضح بالصورة.

يرجى التكرم بمساعدتي لتفادي المشكلة.

دمتم بخير

Capture.PNG

تم تعديل بواسطه مصطفى شاهين
قام بنشر

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

أحسنت أستاذي العزيز على هذه الفكرة لأنها تواجهني بكثرة

وأضفت إلى الكود هذه الفقرة لأنها تواجه من ينسخ الكلام من متصفحات الانترنت

 

' استبدال فاصل الأسطر اليدوي بعلامة الفقرة
   
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "^l"
        .Replacement.Text = "^p"
        .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

  • Like 1
قام بنشر (معدل)

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

بحمد الله تم حل مشكلة الكود السابقة أستاذ محمد،

لي عدة أسئلة، وهي:

  1. في حالة وجود حرف الواو في أول الفقرة كيف يمكن إزالة المسافة بين الواو والكلمة.
  2. وفي حالة وجود مسافة بين القوس الثاني والكلمة، أريد لو سمحت الكود الخاص بذلك، مثال: محمد )، استبدالها بـ محمد).
  3. أي كلمة تبدأ بـ عبد وبعدها لفظ الجلالة تكتب كلمة واحدة، مثال (عبد الرحمن) استبدالها بـ (عبدالرحمن) أريد كود لجعلها كلمة واحدة.

دمتم بخير

تم تعديل بواسطه مصطفى شاهين
قام بنشر

السلام عليكم

الثانية و الثالثة من السهل اضافتها

الطلب الاول منطقي ، و ممكن و لكن يحتاج لبعض التجارب و المحاولات

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

قام بنشر

تم اضافة الطلبات الثلاثة الي الكود

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 = "^pو "
        .Replacement.Text = "^pو"
        .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
        
            
' حذف المسافة بعد القوس
    
    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

 

  • Like 1
قام بنشر (معدل)
في ‎2016‎/‎08‎/‎03 at 20:04, منسق said:

 

أشكرك أستاذ محمد، ولا أنسى الأخ (منسق) وكل القائمين على هذا المنتدى الأكثر من رائع.

دمتم بخير

تم تعديل بواسطه مصطفى شاهين
  • Like 1
  • 2 weeks later...
قام بنشر

تم اضافة مكون اخر و هو حذف المسافة قبل النقطة فى نهاية الجمل

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

 

 

(( تم تحديث الملف فى مشاركة لاحقة))

  • Like 1
قام بنشر

السلام عليكم،

فيما يتعلق بكود حذف المسافة بين كلمة عبد ولفظ الجلالة، يرجى تعديل الكود لـ (حذف المسافة بين كلمة "عبد" والكلمة التي تبدأ بـ"ال")، لأن لفظ الجلالة يبدأ بحرفي (ال)، أما في السابق سيحذف كل مسافة بين عبد وأي كلمة بعدها سواء تبدأ بأل أو غير ذلك، مثال: (عبد فقير لله) ستصبح (عبدفقير لله) وهذا غير مقبول.

مع الاحترام والتقدير

قام بنشر

السلام عليكم

تم التعديل فيما يخص كلمة عبد 

و اضافة حذف المسافة قبل كل من علامتي الفاصلة المنقوطة و النفطتان :

اما عن الملف

فاضغط  ALT+F11

ثم 

File 

import

 و اختار الملف

 

و اخبرني هل تم استيراده داخل ملف 

Normal

ام لا

مرفق الملف المعدل ( بتم استيراد الملف بعد فك الضغط اولا)

WordRemoveArabic.rar

قام بنشر

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

فتعطي  دائما  خطا

فاجعل  فاصلة الجهاز حسب  فاصلة الكود

انظر  الخطوات

 

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

RRT44.jpg

  • Like 1
قام بنشر
في ‎2016‎/‎08‎/‎16 at 17:17, محمد طاهر said:

و اضافة حذف المسافة قبل كل من علامتي الفاصلة المنقوطة و النفطتان :

يرجى إضافة الأكواد كالسابق فيما يخص استبدال كلمة عبد ولفظ الجلالة وعلامتي الفاصلة المنقوطة والنقطتان.

احترامي

قام بنشر

المقصود بالسؤال ، عند ضغط ALT+F11

هل يظهر الملف الذي تم استيراده تحت اسم الملف الحالي او تحت اسم 

Normal

 

بالنسبة للكود هذا هو ، و ما يتغير فى كل مرة هو هذا السطران  فقط:

.Text = " ."
        .Replacement.Text = "."

 


    
    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

 

  • Thanks 1
قام بنشر

السلام عليكم، انه مضمن ضمن الملف السابق

و بيانه كالتالي:

 

' حذف المسافة بعد كلمة عبد
    
    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

 

  • Like 2
قام بنشر

 

و هذا الكود لاستبدال الاسطر الزائدة الى تنتج عند النسخ من ملف  PDF

و يتم تشغيله بعد عمل اختيار للمنطقة المراد التطبيق عليها اولا

Sub ReplaceLineBreak()
'

    With Selection.Find
        .Text = "^p"
        .Replacement.Text = " "
        .Forward = True
        .Wrap = wdFindStop
        .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

  • Like 2
  • 6 months later...
  • 3 weeks later...
  • 9 months later...
قام بنشر
في 7/29/2016 at 10:04, محمد طاهر said:

تواجهني كثير مشكلة وجود مسافات زائدة فى الكتابة سواء عند الكتابة او عند استلام ملفات من الغير

و اغلب هذه المسافات تتمثل فيما يلي:

- مسافة زائدة بعد حرف الواو

- مسافة زائدة قبل الفاصلة

- مسافتين متتاليتين

مما يضيع الكثير من الوقت فى تصحيح الوضع

لذا استخدم حاليا هذا الكود للتغلب على هذه المشكلة.

 

أ/محمد طاهر

كل الشكر والتقدير لمجهودكم وإفادتنا

واطمع فى نفس الموضح عليه ولكنه للاكسيل ويعمل على كل الشيتات مره واحده

بالاضافة الى وضع مسافة قبل بدء الجملة فى كل خلية

ولسيادتكم جزيل الشكر

  • 2 weeks later...
قام بنشر

السلام عليكم

 

بشأن الاكسيل ، اعتقد موضوعك فى قسم الاكسيل يمثل ما تريد

تغيير كلمات بدون فتح الملف

و يرجي التفاعل هنا بخصوص الوورد ففط ، لتعم الفائدة

 

 

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • اضف...

Important Information