كود لتوحيد طريقة كتابة النص العربي لبحث ادق

Public Property Get rooftools53(mycontrol As Control) As String
   'دالة متطورة تحذف الفراغات المتجاورة وتستبدل بعض الحروف _
المتشابهة بحروف بديلة لتسهيل البحث وعدم الالتباس في طريقة _
كتابة تلك الحروف بالعربية
Dim x As Integer, x2 As String, x3 As String, x4 As String
Dim xstr As Integer
x4 = "0123456789"
x4 = x4 & "د": x4 = x4 & "ذ": x4 = x4 & "ا": x4 = x4 & "أ"
x4 = x4 & "إ": x4 = x4 & "لأ": x4 = x4 & "لإ": x4 = x4 & "لا"
x4 = x4 & "آ": x4 = x4 & "ى": x4 = x4 & "ز": x4 = x4 & "ر"
x4 = x4 & "و": x4 = x4 & "ؤ": x4 = x4 & "ة": x4 = x4 & "ء"
x4 = x4 & ".": x4 = x4 & "-": x4 = x4 & "+": x4 = x4 & "/"
x4 = x4 & "": x4 = x4 & " "
123:
For x = 1 To Len(mycontrol)
x2 = Mid(mycontrol, x, 1)
If Asc(x2) = 201 Then x2 = "ه ": xstr = 1 '"ة"
If Asc(x2) = 195 Then x2 = "ا ": xstr = 1 '"أ"
If Asc(x2) = 197 Then x2 = "ا ": xstr = 1 '"إ"
If Asc(x2) = 194 Then x2 = "ا ": xstr = 1 '"آ"
'لان الحرف  لا  مكون من ل و ا
If (x2 = " " And InStrB(x4, x3) <> 0) And x3 <> "ل" Then
x2 = ""
Else
x3 = x2
End If
rooftools53 = Trim(rooftools53) & Trim(x2)
Next x
'لاعادة الكرة مرة اخرى اذا تم تبديل احد الحروف السابقة
If xstr = 1 Then mycontrol = rooftools53: rooftools53 = "": xstr = 0: GoTo 123
End Property