Remove Excessive spaces for Arabic punctuations - VBA Macro

Greetings

How can I run this VBA code
for QA purposes

to remove excessive spaces in the whole target segments

the VBA code:

5751.WordSpaceRemoveArabic.txt
Attribute VB_Name = "WordRemoveArabic"
Sub ArabicSpace()
Attribute ArabicSpace.VB_Description = "remove space in arabic"
Attribute ArabicSpace.VB_ProcData.VB_Invoke_Func = "Normal.NewMacros.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
        
        
              
            
' حذف المسافة قبل النقطة
    
    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



Sub Replace_manual_break()

 

' استبدال فاصل الأسطر اليدوي بعلامة الفقرة
   
     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

End Sub


5751.WordSpaceRemoveArabic.zip



similar to this




regards

Top Replies

  • Always adds a completely new dimension for me when working with bidirectional languages.  But on the face of what I think you are saying you could do something like this...

    Search for this…

Parents Reply Children
No Data