Attribute VB_Name = "ArangwebFree"
Sub nimfasele()
'
'
'
Dim a(500) As String, b(500) As String, c(100) As String, n As Integer, i As Integer, k As Integer

Dim StartTime As Double
Dim SecondsElapsed As Double

Response = MsgBox("اين ويرايش ممکن است چند دقيقه به طول انجامد، لطفا شکيبا باشيد. مي‌توانيد درصد پيشرفت را از قسمت پايين ورد دنبال بفرماييد", vbOKOnly, "ويراستار آرنگ")
  'Remember time when macro starts
  StartTime = Timer

 n = 0
 
  n = 0
    n = n + 1
    a(n) = ChrW(1610)
    b(n) = ChrW(1740)
 
 
     n = n + 1
    a(n) = ChrW(1609)
    b(n) = ChrW(1740)
    
    
    
n = n + 1
    a(n) = "[^s^r^o^-¬‌] "
b(n) = " "
n = n + 1
    a(n) = " [^s^r^o^-¬‌]"
b(n) = " "

n = n + 1
a(n) = "([^s^032^r^o^-¬ ‌])@"
b(n) = "\1"

n = n + 1
a(n) = "([^s^032^r^o^-¬ ‌])@"
b(n) = "\1"

n = n + 1
    a(n) = "[^s^r^o^-‌¬] "
b(n) = " "
n = n + 1
    a(n) = " [^s^r^o^-‌¬]"
    b(n) = " "
    
n = n + 1
    a(n) = "[^s^t^r^o^-¬‌] "
b(n) = " "
n = n + 1
    a(n) = " [^s^t^r^o^-¬‌]"
b(n) = " "

     n = n + 1
    a(n) = "[^o^r]"
       b(n) = "zzzzz‌zzzzz"

        n = n + 1
    a(n) = "zzzzz"
       b(n) = ""

    n = n + 1
    a(n) = "<" & ChrW(1605) & ChrW(1740) & " "
    b(n) = ChrW(1605) & ChrW(1740) & ChrW(8204)
 
  n = n + 1
    a(n) = " " & ChrW(1607) & ChrW(1575) & ">"
    b(n) = ChrW(8204) & ChrW(1607) & ChrW(1575)


  n = n + 1
    a(n) = ChrW(1605) & ChrW(1740) & ChrW(1588) & ChrW(1608)
    b(n) = ChrW(1605) & ChrW(1740) & ChrW(8204) & ChrW(1588) & ChrW(1608)

Selection.HomeKey wdStory: Selection.Find.ClearFormatting
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
For i = 1 To n
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
With Selection.Find

 .Text = a(i): .Replacement.Text = b(i): .Format = False: .MatchWholeWord = False: .MatchAllWordForms = False: .MatchWildcards = True: .Execute Replace:=wdReplaceAll: .Forward = True:   .Wrap = wdFindContinue
        .MatchCase = False:         .MatchWholeWord = False:         .MatchControl = False:           .MatchSoundsLike = False
        .MatchAllWordForms = False
                  If i Mod 15 = 0 Then     ' If loop has repeated 1000 times.
        OpenForms = DoEvents    ' Yield to operating system.

           End If
         Application.StatusBar = "=============================================>Virastar Arang Progress: " & i & " of " & n & " : " & Format(i / n, "0%")  ' speed down

      
End With
      
Next i



'Determine how many seconds code took to run
  SecondsElapsed = Round(Timer - StartTime, 2)

'Notify user in seconds
  MsgBox "اين نرم افزار با موفقيت در " & SecondsElapsed & " ثانيه اجرا شد", vbInformation, "ويراستار آرنگ"
   ' speed up progress bar
    
    
 
Msg = "براي تهيه محصول اصلي و دريافت تمام بروزرساني‌هاي رايگان آن به وبسايت استوديو آرنگ arangweb.com مراجعه بفرماييد. در نسخه اصلي نيم فاصله‌هاي بسيار پيچيده نيز اصلاح مي‌گردند. همچنين فاصله‌گذاري‌هاي بعد و قبل نقطه‌ها، ويرگول‌ها، علامت سوال، علامت تعجب، دو نقطه و غيره نيز اصلاح مي‌گردند. فاصله‌ها در عبارات مرکبي نظير (شبيه سازي، باستان شناس، و بيش از 10 هزار ترکيب ديگر) تبديل به نيم فاصله مي‌شوند. نيم‌فاصله در  افعالي که داراي (مي) و (نمي) چسبيده هستند مانند ميشود اصلاح به مي‌شود. همچنين افعال جمع چسبيده مانند صبحها تبديل به صبح‌ها، دوستهاي به دوست‌هاي و غيره. به علاوه تنوين‌ها، حمزه‌ها و برخي از غلط‌هاي املايي رايج مانند خدمتگذار به خدمت‌گزار، گزاشتن به گذاشتن و غيره نيز اصلاح مي‌گردند"
Style = vbMsgBoxRtlReading   ' Define buttons.
Title = "تهيه محصول اصلي"    ' Define title.

Response = MsgBox(Msg, Style, Title)
    
    
End Sub

