Remove Excessive spaces for Arabic punctuations - VBA Macro

Question

Greetings 
 How can I run this VBA code for QA purposes 
 to remove excessive spaces in the whole target segments the VBA code:

Fullscreen 
 5751.WordSpaceRemoveArabic.txt 
 Download 
 
 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

Paul · Accepted Answer

aazzoma khateeb 
 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: 
 \s+([!؟)]) 
 Replace with this: 
 $1 
 So your search window would be this: 
 
 This isn't exhaustive, but it might give you an idea on how to approach this task. 
 You might also want to create QA rules to identify them as you work. That might be even better as it'll save you having to find the mistakes and replace them afterwards... it's also very simple to use: 
 
 Just check the box in your project settings for punctuation (1), then add the chars you want to use in (2).

Paul · Answer

aazzoma khateeb 
 If you are asking whether you can run this code in Studio then the answer is no, you can't. You would have rewrite the functionality using the APIs... or maybe using AHK and applying it to the native file. I'd go the API route. 
 If you are just asking how to run the code in Word then maybe this will help you: 
 https://www.datanumen.com/blogs/how-to-run-vba-code-in-your-word/

Trados Studio > 5. Regex and XPath

Remove Excessive spaces for Arabic punctuations - VBA Macro

Top Replies