שיתוף | המשך - "מתעדכן" אוסף מאקרו לוורד - אינדקס מאקרו שימושי + הוראות חשובות.

[אביעד]

Spoiler

יישר כח
אממ. לגבי מה שאמרת שם שלא הייתי צריך לפרט -זה לא אישי.. בד''כ יש עוד כאלה שמסתכלים ולא כולם יודעים.. אז אם לא יועיל לא יזיק

[יאיר דניאל]

מאקרו קטן שכתבתי (בעזרת הAI - כי פשוט קצת הסתבכתי לבד...)
לגיבוי של כל ההגדרות האישיות באופיס, כמו תיקוני שגיאות, תבנית נורמל, מילון, פקודות המאקרו ועיצוב הכרטיסיות שלכם.
זהו מאקרו כפול - גיבוי, ושחזור למיקום המקורי.
זה חשוב לגבות מידי פעם, מנסיון...

• התיקייה שתיווצר לאחר הרצת המאקרו - לא שוקלת כמעט כלום, אבל היא תחסוך לכם הרבה עבודה - כשיימחק לכם ההגדרות איכשהו/ תאפסו את המחשב/ תעשו התקנה נקייה/ תקנו מחשב חדש!

מאקרו גיבוי תבנית נורמל:

[זה מאקרו שכתב אי מי מחברי הפורום, אינני זוכר מי כך שאני לא יכול לתת לו את הקרדיט המגיע לו - לגיבוי של תבנית הנורמל

Sub גיבוי_תבנית_נורמל()
    Dim fso As Object
    Dim sourcePath As String
    Dim destPath As String
    Dim fileName As String
    Dim dateTimeStamp As String
 
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    sourcePath = "C:\Users\ZMB\AppData\Roaming\Microsoft\Templates\"
    destPath =  **הזינו כאן את הנתיב בו תרצו לשמור את התבנית**
    dateTimeStamp = Format(Now, "dd_mm_yy_hh_mm_ss")
    
    fileName = "Normal.dotm"
    
    If Not fso.FolderExists(destPath) Then
        fso.CreateFolder destPath
    End If
    
    If fso.FileExists(sourcePath & fileName) Then
        fso.CopyFile sourcePath & fileName, destPath & Left(fileName, Len(fileName) - 5) & "_" & dateTimeStamp & ".dotm"
        
        MsgBox "הקובץ הועתק בהצלחה ונוסף לתיקיית הגיבוי."
    Else
        MsgBox "הקובץ המקורי אינו קיים."
    End If
    
    Set fso = Nothing
End Sub

מאקרו גיבוי התאמות אישיות:

• מאקרו זה מגבה את הקבצים הבאים:
  מילון אישי
  תיקון שגיאות אוטומטי
  התאמות אישיות בוורד, אקסל, אקסס
  תבנית נורמל

Option Explicit

Sub גיבוי_ושחזור_התאמות_משתמש()

    Dim fso As Object
    Dim user As String
    Dim basePath As String
    Dim פעולה As VbMsgBoxResult
    Dim src As String, dst As String

    Set fso = CreateObject("Scripting.FileSystemObject")
    user = CreateObject("WScript.Network").UserName

    פעולה = MsgBox( _
        "בחר פעולה:" & vbCrLf & _
        "כן = גיבוי" & vbCrLf & _
        "לא = שחזור", _
        vbYesNoCancel + vbQuestion, _
        "Office PRO")

    If פעולה = vbCancel Then Exit Sub

    With Application.FileDialog(4)
        .Title = IIf(פעולה = vbYes, "בחר תיקייה לגיבוי", "בחר תיקיית גיבוי")
        If .Show <> -1 Then Exit Sub
        basePath = .SelectedItems(1)
    End With

    ' ================= UI – Excel =================
    CreateFolderIfMissing fso, basePath & "\UI"
    If פעולה = vbYes Then
        src = "C:\Users\" & user & "\AppData\Local\Microsoft\Office\Excel.officeUI"
        dst = basePath & "\UI\Excel.officeUI"
    Else
        src = basePath & "\UI\Excel.officeUI"
        dst = "C:\Users\" & user & "\AppData\Local\Microsoft\Office\Excel.officeUI"
    End If
    CopyFileSafe fso, src, dst

    ' ================= UI – Word =================
    If פעולה = vbYes Then
        src = "C:\Users\" & user & "\AppData\Local\Microsoft\Office\Word.officeUI"
        dst = basePath & "\UI\Word.officeUI"
    Else
        src = basePath & "\UI\Word.officeUI"
        dst = "C:\Users\" & user & "\AppData\Local\Microsoft\Office\Word.officeUI"
    End If
    CopyFileSafe fso, src, dst

    ' ================= Normal.dotm =================
    CreateFolderIfMissing fso, basePath & "\Word"
    If פעולה = vbYes Then
        src = "C:\Users\" & user & "\AppData\Roaming\Microsoft\Templates\Normal.dotm"
        dst = basePath & "\Word\Normal.dotm"
    Else
        src = basePath & "\Word\Normal.dotm"
        dst = "C:\Users\" & user & "\AppData\Roaming\Microsoft\Templates\Normal.dotm"
    End If
    CopyFileSafe fso, src, dst

    ' ================= Office (Roaming) =================
    CreateFolderIfMissing fso, basePath & "\Office"
    If פעולה = vbYes Then
        src = "C:\Users\" & user & "\AppData\Roaming\Microsoft\Office"
        dst = basePath & "\Office"
    Else
        src = basePath & "\Office"
        dst = "C:\Users\" & user & "\AppData\Roaming\Microsoft\Office"
    End If
    CopyFolderSafe fso, src, dst

    ' ================= UProof =================
    CreateFolderIfMissing fso, basePath & "\UProof"
    If פעולה = vbYes Then
        src = "C:\Users\" & user & "\AppData\Roaming\Microsoft\UProof"
        dst = basePath & "\UProof"
    Else
        src = basePath & "\UProof"
        dst = "C:\Users\" & user & "\AppData\Roaming\Microsoft\UProof"
    End If
    CopyFolderSafe fso, src, dst

    ' ================= Spelling =================
    CreateFolderIfMissing fso, basePath & "\Spelling"
    If פעולה = vbYes Then
        src = "C:\Users\" & user & "\AppData\Roaming\Microsoft\Spelling"
        dst = basePath & "\Spelling"
    Else
        src = basePath & "\Spelling"
        dst = "C:\Users\" & user & "\AppData\Roaming\Microsoft\Spelling"
    End If
    CopyFolderSafe fso, src, dst

    ' ================= Excel (Roaming) =================
    CreateFolderIfMissing fso, basePath & "\Excel"
    If פעולה = vbYes Then
        src = "C:\Users\" & user & "\AppData\Roaming\Microsoft\Excel"
        dst = basePath & "\Excel"
    Else
        src = basePath & "\Excel"
        dst = "C:\Users\" & user & "\AppData\Roaming\Microsoft\Excel"
    End If
    CopyFolderSafe fso, src, dst

    ' ================= Access =================
    CreateFolderIfMissing fso, basePath & "\Access"
    If פעולה = vbYes Then
        src = "C:\Users\" & user & "\AppData\Roaming\Microsoft\Access"
        dst = basePath & "\Access"
    Else
        src = basePath & "\Access"
        dst = "C:\Users\" & user & "\AppData\Roaming\Microsoft\Access"
    End If
    CopyFolderSafe fso, src, dst

    MsgBox IIf(פעולה = vbYes, _
        "הגיבוי הושלם בהצלחה", _
        "השחזור הושלם בהצלחה"), _
        vbInformation, "Office PRO"

End Sub

' ================= עזר =================
Sub CreateFolderIfMissing(fso As Object, path As String)
    If Not fso.FolderExists(path) Then fso.CreateFolder path
End Sub

Sub CopyFileSafe(fso As Object, src As String, dst As String)
    If fso.FileExists(src) Then
        CreateFolderIfMissing fso, fso.GetParentFolderName(dst)
        On Error Resume Next
        If fso.FileExists(dst) Then fso.DeleteFile dst, True
        fso.CopyFile src, dst, True
        Err.Clear
        On Error GoTo 0
    End If
End Sub

Sub CopyFolderSafe(fso As Object, src As String, dst As String)
    If fso.FolderExists(src) Then
        CreateFolderIfMissing fso, fso.GetParentFolderName(dst)
        fso.CopyFolder src, dst, True
    End If
End Sub

[מניין]

@יאיר-דניאל כתב בשיתוף | המשך - "מתעדכן" אוסף מאקרו לוורד - אינדקס מאקרו שימושי + הוראות חשובות.:

הנה מאקרו קטן שכתבתי (בעזרת הAI - כי פשוט קצת הסתבכתי לבד...)
לגיבוי של כל ההגדרות האישיות באופיס, כמו תיקוני שגיאות, תבנית נורמל, מילון, פקודות המאקרו ועיצוב הכרטיסיות שלכם.

האם זה שומר גם על כל הכרטיסיות, הקיצורי דרך, והמאקרואים.

[יאיר דניאל]

@מניין כתב בשיתוף | המשך - "מתעדכן" אוסף מאקרו לוורד - אינדקס מאקרו שימושי + הוראות חשובות.:

האם זה שומר גם על כל הכרטיסיות, הקיצורי דרך, והמאקרואים.

כן, על המאקרואים ודאי - זה נמצא בתוך התבנית נורמל שנשמרת, ושאר הדברים גם אמור להיות לפי הנתיבים שבהם הם נמצאים, מה שכן, כיון שלא ניסתי בפועל, הייתי ממליץ לך לנסות ולראות.
אני אנסה עוד כמה דקות ואעדכן אותך פה

[יאיר דניאל]

מאקרו להקטנת סוגריים עגולות ומרובעות בתוך הטקסט:

(כרגע הוא מוגדר על הקטנת סוגריים מרובעות לגודל 11 ועגולות לגודל 9 - כמובן שתוכלו לשנות את זה כטוב בעינכם).

Sub הקטנת_סוגריים()
'
' הקטנת_סוגריים Macro
'
'
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "\[*\]"
        .Replacement.Text = "^&"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
        .Replacement.Font.SizeBi = 11
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "\(*\)"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
        .Replacement.Font.SizeBi = 9
        .Replacement.Font.Size = 9
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub

לעצלנים שבינינו - מצורף גם אותו המאקרו - להערות שוליים, עם הגדרות גודל יותר קטנות = 7 למרובע, 6 לעגול.
שימו לב! את המאקרו העליון - הפעילו בעוד הסמן עומד בטקסט עצמו, ואת המאקרו התחתון - בעוד הסמן עומד בהערות השוליים.

Sub הקטנת_סוגריים_הערת_שוליים()
'
' הקטנת_סוגריים_הערת_שוליים Macro
'
'
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "\[*\]"
        .Replacement.Text = "^&"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
        .Replacement.Font.SizeBi = 7
     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 = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
        .Replacement.Font.SizeBi = 6
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub

[יאיר דניאל]

מאקרו לסימון אותיות בתשובות לעיון ההלכה

• למי שנוהג לכתוב בצורת התבנית הבאה:
  
• מה שהמאקרו הזה עושה הוא כך:
  א. מדגיש ומוסיף פס תחתון למספר התשובה.
  ב. מדגיש את מספר האות - בתוך כל תשובה.

Sub סימון_אותיות_עיון_ההלכה()
'
' סימון_אותיות_עיון_ההלכה Macro
'
'
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find.Replacement.Font
        .BoldBi = True
        .Underline = wdUnderlineSingle
    End With
    With Selection.Find
        .Text = "^p^$:"
        .Replacement.Text = "^&"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        .Replacement.Font.NameBi = "ShefaClassic"
    End With
       Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find.Replacement.Font
        .BoldBi = True
        .Underline = 0
    End With
    With Selection.Find
        .Text = "(^$) "
        .Replacement.Text = "^&"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        .Replacement.Font.NameBi = "ShefaClassic"
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub

הערה קטנה וחשובה:
כעת המאקרו מוגדר להחליף לפונט: ShefaClassic, תוכלו כמובן לשנות זאת לכל פונט העולה על רוחכם - פשוט החליפו את שם הפונט בשורה הזו:

  .Replacement.Font.NameBi = "ShefaClassic"

[יאיר דניאל]

מאקרו שיצרתי לבקשתו של אחד מחברי הפורום - להחלפת גופנים ע"י מאקרו.

גירסה א:

Sub FinalFont_InstantUpdate()
    Dim selectedFont As String
    Dim lastUsedFont As String
    Dim answer As VbMsgBoxResult
    
    ' 1. בחירה מפורשת של הכל אם לא סומן כלום
    If Selection.Start = Selection.End Then
        ActiveDocument.Range.Select
    End If
    
    ' 2. שליפת הגופן האחרון
    lastUsedFont = GetSetting("MyWordMacros", "Settings", "LastFont", "David")
    
    ' 3. שאלה למשתמש
    answer = MsgBox("האם להשתמש בגופן האחרון: " & lastUsedFont & "?" & vbCrLf & _
                    "לחץ 'כן' לביצוע, או 'לא' לבחירה מרשימה.", _
                    vbYesNoCancel + vbQuestion + vbMsgBoxRight + vbMsgBoxRtlReading, "החלפת גופן")
    
    If answer = vbYes Then
        selectedFont = lastUsedFont
    ElseIf answer = vbNo Then
        With Application.Dialogs(wdDialogFormatFont)
            If .Show = -1 Then
                selectedFont = Selection.Font.NameBi
                If selectedFont = "" Or selectedFont = "0" Then selectedFont = Selection.Font.Name
            End If
        End With
        
        If selectedFont <> "" And selectedFont <> "0" Then
            SaveSetting "MyWordMacros", "Settings", "LastFont", selectedFont
        Else
            Selection.Collapse Direction:=wdCollapseStart
            Exit Sub
        End If
    Else
        Selection.Collapse Direction:=wdCollapseStart
        Exit Sub
    End If
    
    ' 4. ביצוע השינוי עם עדכון מסך כפוי
    If selectedFont <> "" Then
        Application.ScreenUpdating = False ' מכבה עדכון כדי להאיץ
        
        On Error Resume Next
        With Selection.Font
            .NameBi = selectedFont 
            .Name = selectedFont   
        End With
        On Error GoTo 0
        
        ' פקודות לרענון מיידי של המסך
        Application.ScreenUpdating = True ' מדליק חזרה ומאלץ רענון
        DoEvents ' משחרר את המערכת לעדכון גרפי
        Application.ScreenRefresh ' רענון סופי של Word
        
        Selection.Collapse Direction:=wdCollapseStart
        Application.StatusBar = "הגופן עודכן ל-" & selectedFont
    End If
End Sub

Spoiler

גירסה ב:

בחירת גופן להחלפה - מתוך רשימה

Sub ReplaceSpecificFont()
    Dim docFonts As New Collection
    Dim targetFont As String
    Dim replacementFont As String
    Dim lastUsedFont As String
    Dim i As Long
    Dim fontChoice As String
    Dim answer As VbMsgBoxResult

    ' 1. סריקת המסמך לזיהוי פונטים קיימים
    On Error Resume Next
    Dim para As Paragraph
    For Each para In ActiveDocument.Paragraphs
        ' הוספת הגופן הרגיל והגופן העברי לאוסף
        If para.Range.Font.Name <> "" Then docFonts.Add para.Range.Font.Name, para.Range.Font.Name
        If para.Range.Font.NameBi <> "" Then docFonts.Add para.Range.Font.NameBi, para.Range.Font.NameBi
    Next para
    On Error GoTo 0

    If docFonts.Count = 0 Then
        MsgBox "לא נמצאו גופנים מזוהים.", vbExclamation
        Exit Sub
    End If

    ' 2. בחירת הגופן להחלפה
    Dim fontList As String
    fontList = "בחר מספר גופן להחלפה:" & vbCrLf
    For i = 1 To docFonts.Count
        fontList = fontList & i & ". " & docFonts(i) & vbCrLf
    Next i

    fontChoice = InputBox(fontList, "חפש והחלף גופן")
    If Not IsNumeric(fontChoice) Then Exit Sub
    i = CInt(fontChoice)
    If i < 1 Or i > docFonts.Count Then Exit Sub
    targetFont = docFonts(i)

    ' 3. בחירת גופן היעד
    lastUsedFont = GetSetting("MyWordMacros", "Settings", "LastFont", "David")
    answer = MsgBox("להחליף את " & targetFont & " ב-" & lastUsedFont & "?" & vbCrLf & _
                    "לחץ 'כן' לאישור, או 'לא' לבחירה מרשימה.", _
                    vbYesNoCancel + vbQuestion + vbMsgBoxRight + vbMsgBoxRtlReading)

    If answer = vbYes Then
        replacementFont = lastUsedFont
    ElseIf answer = vbNo Then
        With Application.Dialogs(wdDialogFormatFont)
            If .Show = -1 Then
                replacementFont = Selection.Font.NameBi
                If replacementFont = "" Or replacementFont = "0" Then replacementFont = Selection.Font.Name
            End If
        End With
    Else
        Exit Sub
    End If

    If replacementFont = "" Or replacementFont = "0" Then Exit Sub
    SaveSetting "MyWordMacros", "Settings", "LastFont", replacementFont

    ' 4. ביצוע ההחלפה (שיטה משופרת)
    Application.ScreenUpdating = False
    
    ' פקודת ההחלפה צריכה לרוץ פעמיים כדי לכסות גם עברית וגם אנגלית בוודאות
    Call ExecuteFontReplace(targetFont, replacementFont, True)  ' עבור עברית
    Call ExecuteFontReplace(targetFont, replacementFont, False) ' עבור אנגלית

    Application.ScreenUpdating = True
    Application.ScreenRefresh
    
    MsgBox "הפעולה הושלמה עבור הגופן: " & targetFont, vbInformation
End Sub

' פונקציית עזר לביצוע ההחלפה בפועל' פונקציית עזר לביצוע ההחלפה בפועל - עם שמות פרמטרים תקינים
Sub ExecuteFontReplace(fTarget As String, fReplace As String, isBi As Boolean)
    Dim r As Range
    Set r = ActiveDocument.Content
    
    r.Find.ClearFormatting
    r.Find.Replacement.ClearFormatting
    
    If isBi Then
        r.Find.Font.NameBi = fTarget
        r.Find.Replacement.Font.NameBi = fReplace
    Else
        r.Find.Font.Name = fTarget
        r.Find.Replacement.Font.Name = fReplace
    End If
    
    ' התיקון הקריטי: FindText במקום Text, ו-ReplaceWith במקום ReplacementText
    r.Find.Execute FindText:="", ReplaceWith:="", _
        Forward:=True, Wrap:=wdFindContinue, Format:=True, Replace:=wdReplaceAll
End Sub

זה עובד כך - תמונות בספויילר

Spoiler

גירסה ג:

(כמו גירסה ב' אבל לא צריך להקליד מספר גופן - אלא בוחרים בגופן עצמו - ההמשך אותו דבר).

פשוט להפעיל את הקובץ המצורף
החלפת גופנים.exe

או להכניס את הקובץ המצורף- לתיקיית הטמפלס של אופיס
(הקובץ למעלה - עושה את זה אוטומטית)

החלפת גופנים.dotm

Spoiler

[יאיר דניאל]

מאקרו תיקון סמינים כפולים ושגיאות הקלדה

(פירוט הפעולות שנעשות ע"י המאקרו - בספויילר בסוף ההודעה)

העליתי בעבר מאקרו לתיקון סימנים כפולים ושגיאות הקלדה - משהו שיצרתי לאט לאט - תוכ"ד כתיבה ושימת לב לשגיאות נפוצות, הבעיה היא שהוא לא היה כתוב נכון, מכיון שהוא גרם לוורד לעשות כל פעולת החלפה - על כל המסמך ואז שוב - ההחלפה הבאה, מהתחלה ועד הסוף, מה שיצר גם קוד ארוך במיוחד.

הנה הוא, סתם לשם התרשמות:

Sub תיקון_סימנים_כפולים_ועוד()
'
' תיקון_סימנים_כפולים_ועוד Macro
'
'
'
    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.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = ".{4,}"
        .Replacement.Text = "."
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    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
    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
    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.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
    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
    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
    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
    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
    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
    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
    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
    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
    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
    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
    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
    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
    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
    Selection.Find.Replacement.Font.Color = wdColorRed
    With Selection.Find
        .Text = " ם"
        .Replacement.Text = "^&"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .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
    With Selection.Find
        .Text = " ן"
        .Replacement.Text = "^&"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .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
    With Selection.Find
        .Text = " ץ"
        .Replacement.Text = "^&"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .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
    With Selection.Find
        .Text = " ף"
        .Replacement.Text = "^&"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .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
    With Selection.Find
        .Text = " ך"
        .Replacement.Text = "^&"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Font.Color = wdColorRed
    With Selection.Find
    With Selection.Find
        .Text = "ם[א-ת]"
        .Replacement.Text = "^&"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "ן[א-ת]"
        .Replacement.Text = "^&"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "ץ[א-ת]"
        .Replacement.Text = "^&"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "ף[א-ת]"
        .Replacement.Text = "^&"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "ך[א-ת]"
        .Replacement.Text = "^&"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Font.Color = wdColorRed
    With Selection.Find
        .Text = " [א-ת] "
        .Replacement.Text = "^&"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = " [א-ת]^13"
        .Replacement.Text = "^&"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Font.Color = wdColorAutomatic
    With Selection.Find
        .Text = "ן [א-ת] "
        .Replacement.Text = "^&"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "ק [א-ת] "
        .Replacement.Text = "^&"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "ה [א-ת] "
        .Replacement.Text = "^&"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "ף [א-ת] "
        .Replacement.Text = "^&"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "ת [א-ת] "
        .Replacement.Text = "^&"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "ש [א-ת] "
        .Replacement.Text = "^&"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "ג [א-ת] "
        .Replacement.Text = "^&"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "' [א-ת] "
        .Replacement.Text = "^&"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "ן [א-ת]^13"
        .Replacement.Text = "^&"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "ק [א-ת]^13"
        .Replacement.Text = "^&"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "ה [א-ת]^13"
        .Replacement.Text = "^&"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "ף [א-ת]^13"
        .Replacement.Text = "^&"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "ת [א-ת]^13"
        .Replacement.Text = "^&"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "ש [א-ת]^13"
        .Replacement.Text = "^&"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "ג [א-ת]^13"
        .Replacement.Text = "^&"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "' [א-ת]^13"
        .Replacement.Text = "^&"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    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
    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
    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
    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
    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
    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
    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 = "(.)([! ^13]*>)"
        .Replacement.Text = "\1 \2"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "(,)([! ^13]*>)"
        .Replacement.Text = "\1 \2"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "([! ^13'""])([(\[])"
        .Replacement.Text = "\1 \2"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "([)\]])([! ^13.,'""\?\!])"
        .Replacement.Text = "\1 \2"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    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
    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
    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.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
    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.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.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^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
    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.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Font.Color = wdColorRed
    With Selection.Find
        .Text = """^$'"
        .Replacement.Text = "^&"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .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 = "^l ["
        .Replacement.Text = "^l["
        .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
    With Selection.Find
        .Text = " ^l ["
        .Replacement.Text = "^l["
        .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 With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub

ביקשתי מג'מיני - ייעול של הקוד, והנה הוא לפניכם - בתוספת חלונית מידע בסוף הריצה על כמות התיקונים שהמאקרו ביצע.
אשמח להערות והארות עליו, מה ניתן להוסיף ולשפר, ומה לא עובד בו טוב, לא עברתי על הקוד שנוצר בעיון, רק בדקתי שהוא רץ טוב ושהוא באמת מתקן.

Sub תיקון_סימנים_כפולים_ ועוד()
    ' עצירת רענון המסך למהירות ריצה מקסימלית
    Application.ScreenUpdating = False
    
    Dim cntPunctuation As Long
    Dim cntSpaces As Long
    Dim cntRed As Long
    Dim cntClean As Long
    Dim i As Long
    Dim spacesChanged As Long
    
    Dim arrFind As Variant, arrRep As Variant
    
    ' =======================================================
    ' --- קטגוריה 1: סימני פיסוק וכפילויות (סדר פעולות קריטי) ---
    ' =======================================================
    
    ' 1. נקודה כפול 4 ומעלה -> החלף בנקודה בודדת
    cntPunctuation = cntPunctuation + FastReplaceAndCount(".{4,}", ".", True)
    
    ' 2. הגנה על 3 נקודות (...) כדי שלא ייהרסו - החלפה זמנית למחרוזת ייחודית
    cntPunctuation = cntPunctuation + FastReplaceAndCount("...", "|||", False)
    
    ' 3. נקודה כפולה (..) -> החלף בנקודה בודדת
    cntPunctuation = cntPunctuation + FastReplaceAndCount("..", ".", False)
    
    ' 4. החזרת ה-3 נקודות (...) למקומן המקורי
    cntPunctuation = cntPunctuation + FastReplaceAndCount("|||", "...", False)
    
    ' 5. שלושה ייי -> החלף לשניים
    cntPunctuation = cntPunctuation + FastReplaceAndCount("ייי", "יי", False)
    
    ' 6. שאר הכפילויות (פסיק כפול, גרש כפול, מרכאות כפולות כפולות, ואותיות סופיות כפולות)
    arrFind = Array(",,", "''", "םם", "ןן", "ץץ", "ףף", "ךך", """""")
    arrRep = Array(",", "'", "ם", "ן", "ץ", "ף", "ך", """")
    For i = LBound(arrFind) To UBound(arrFind)
        cntPunctuation = cntPunctuation + FastReplaceAndCount(CStr(arrFind(i)), CStr(arrRep(i)), False)
    Next i
    
    ' =======================================================
    ' --- קטגוריה 2: תיקוני רווחים, סוגריים ומעברים ---
    ' =======================================================
    
    ' 1. רווח כפול -> החלף ברווח בודד (בלולאה עד לניקוי מלא של רווחים משולשים ומעלה)
    Do
        spacesChanged = FastReplaceAndCount("  ", " ", False)
        cntSpaces = cntSpaces + spacesChanged
    Loop While spacesChanged > 0
    
    ' 2. אנטר כפול -> החלף באנטר בודד
    cntSpaces = cntSpaces + FastReplaceAndCount("^p^p", "^p", False)
    
    ' 3. רווח ואז מעבר שורה או מעבר פסקה -> מחק את הרווח
    cntSpaces = cntSpaces + FastReplaceAndCount(" ^l", "^l", False)
    cntSpaces = cntSpaces + FastReplaceAndCount(" ^p", "^p", False)
    cntSpaces = cntSpaces + FastReplaceAndCount("^p ", "^p", False)
    
    ' 4. מילה רווח ואז נקודה/פסיק/גרש -> החלף בסימן ואז רווח
    cntSpaces = cntSpaces + FastReplaceAndCount(" .", ". ", False)
    cntSpaces = cntSpaces + FastReplaceAndCount(" ,", ", ", False)
    cntSpaces = cntSpaces + FastReplaceAndCount(" '", "' ", False)
    
    ' 5. רווחים סביב סוגריים (פותח וסוגר)
    cntSpaces = cntSpaces + FastReplaceAndCount("( ", "(", False)
    cntSpaces = cntSpaces + FastReplaceAndCount("[ ", "[", False)
    cntSpaces = cntSpaces + FastReplaceAndCount(" )", ")", False)
    cntSpaces = cntSpaces + FastReplaceAndCount(" ]", "]", False)
    
    ' 6. סוגר סוגריים שאחריו רווח ופסיק או נקודה -> מחק את הרווח
    cntSpaces = cntSpaces + FastReplaceAndCount(") .", ").", False)
    cntSpaces = cntSpaces + FastReplaceAndCount(") ,", "),", False)
    cntSpaces = cntSpaces + FastReplaceAndCount("] .", "].", False)
    cntSpaces = cntSpaces + FastReplaceAndCount("] ,", "],", False)
    
    ' 7. נקודה/פסיק ואחריהם סוגריים -> העברה אל אחרי הסוגריים (בתנאי שאין שם כבר)
    cntSpaces = cntSpaces + FastReplaceAndCount("\.([\(\)\[\]])\.", "\1.", True)
    cntSpaces = cntSpaces + FastReplaceAndCount("\.([\(\)\[\]])", "\1.", True)
    cntSpaces = cntSpaces + FastReplaceAndCount("\,([\(\)\[\]])\,", "\1,", True)
    cntSpaces = cntSpaces + FastReplaceAndCount("\,([\(\)\[\]])", "\1,", True)
    
    ' 8. נקודה או פסיק ואז תו שאינו רווח (אות עברית) -> הוספת רווח אחרי הסימן
    cntSpaces = cntSpaces + FastReplaceAndCount("(\.)([א-ת])", "\1 \2", True)
    cntSpaces = cntSpaces + FastReplaceAndCount("(\,)([א-ת])", "\1 \2", True)
    
    ' 9. גרש בסוף מילה כאשר יש כבר מרכאות בתוך המילה -> מחק את הגרש המיותר בסוף
    cntSpaces = cntSpaces + FastReplaceAndCount("([א-ת])""([א-ת]+)'", "\1""\2", True)
    
    ' 10. רווח ואז אות סופית -> אות סופית ואז רווח
    arrFind = Array(" ם", " ן", " ץ", " ף", " ך")
    arrRep = Array("ם ", "ן ", "ץ ", "ף ", "ך ")
    For i = LBound(arrFind) To UBound(arrFind)
        cntSpaces = cntSpaces + FastReplaceAndCount(CStr(arrFind(i)), CStr(arrRep(i)), False)
    Next i
    
    ' =======================================================
    ' --- קטגוריה 3: צביעה באדום לסימון שגיאות ---
    ' =======================================================
    
    ' 1. אות סופית ואז אות רגילה מ-א' עד ת' (ללא רווח ביניהן)
    cntRed = cntRed + FastReplaceAndCount("[םןץףך][א-ת]", "^&", True, wdColorRed)
    
    ' 2. רווח - אות בודדת - רווח (או מעבר פסקה)
    cntRed = cntRed + FastReplaceAndCount(" [א-ת] ", "^&", True, wdColorRed)
    cntRed = cntRed + FastReplaceAndCount(" [א-ת]^13", "^&", True, wdColorRed)
    
    ' 3. סוף מילה ואחריה מרכאות -> צביעת המרכאות בלבד באדום (מבלי לגעת בראשי תיבות!)
    Selection.HomeKey Unit:=wdStory
    With Selection.Find
        .ClearFormatting
        .Text = "[א-ת]"""
        .MatchWildcards = True
        .Wrap = wdFindStop
        
        Dim lastPosQuote As Long
        lastPosQuote = -1
        
        Do While .Execute
            If Selection.Start = lastPosQuote Then Exit Do
            lastPosQuote = Selection.Start
            
            Dim isAcronym As Boolean
            isAcronym = False
            
            ' בודקים את התו שמופיע מיד אחרי המרכאות
            If Selection.End < ActiveDocument.Content.End Then
                Dim nextChar As String
                nextChar = ActiveDocument.Range(Selection.End, Selection.End + 1).Text
                ' אם התו הבא הוא אות עברית, סימן שמדובר בראשי תיבות
                If nextChar Like "[א-ת]" Then
                    isAcronym = True
                End If
            End If
            
            ' צובעים רק אם לא מדובר בראשי תיבות
            If Not isAcronym Then
                ActiveDocument.Range(Selection.End - 1, Selection.End).Font.Color = wdColorRed
                cntRed = cntRed + 1
            End If
            
            Selection.Collapse wdCollapseEnd
        Loop
    End With
    
    ' =======================================================
    ' --- קטגוריה 4: ניקוי הדגשות אדומות מותרות (חריגים) ---
    ' =======================================================
    ' החזרת צבע אוטומטי לאותיות בודדות שמגיעות אחרי האותיות המותרות בדרישה
    arrFind = Array("ן [א-ת] ", "ק [א-ת] ", "ה [א-ת] ", "ף [א-ת] ", "ת [א-ת] ", "ש [א-ת] ", "ג [א-ת] ", "' [א-ת] ", "ם [א-ת] ", _
                    "ן [א-ת]^13", "ק [א-ת]^13", "ה [א-ת]^13", "ף [א-ת]^13", "ת [א-ת]^13", "ש [א-ת]^13", "ג [א-ת]^13", "' [א-ת]^13", "ם [א-ת]^13")
    For i = LBound(arrFind) To UBound(arrFind)
        cntClean = cntClean + FastReplaceAndCount(CStr(arrFind(i)), "^&", True, wdColorAutomatic)
    Next i
    
    ' =======================================================
    ' --- קטגוריה 5: תיקון באג סוגריים הפוכים ב-Word RTL ---
    ' =======================================================
    Selection.HomeKey Unit:=wdStory
    With Selection.Find
        .ClearFormatting
        .Text = "[\(\)\[\]]"
        .MatchWildcards = True
        .Wrap = wdFindStop
        
        Dim lastPosBracket As Long
        lastPosBracket = -1
        
        Do While .Execute
            If Selection.Start = lastPosBracket Then Exit Do
            lastPosBracket = Selection.Start
            
            Dim charFont As String
            charFont = ""
            
            If Selection.End < ActiveDocument.Content.End Then
                charFont = ActiveDocument.Range(Selection.End, Selection.End + 1).Font.NameBi
            End If
            If charFont = "" And Selection.Start > 0 Then
                charFont = ActiveDocument.Range(Selection.Start - 1, Selection.Start).Font.NameBi
            End If
            
            If charFont <> "" Then
                Selection.Font.Name = charFont
                Selection.Font.NameBi = charFont
                Selection.Font.NameAscii = charFont
                Selection.Font.NameOther = charFont
            End If
            Selection.Collapse wdCollapseEnd
        Loop
    End With
    
    ' הפעלת רענון המסך בחזרה בסיום הריצה
    Application.ScreenUpdating = True
    
    ' =======================================================
    ' --- 6. הפקת הודעת דיווח וסיכום ---
    ' =======================================================
    Dim msg As String
    Dim totalChanges As Long
    totalChanges = cntPunctuation + cntSpaces + cntRed + cntClean
    
    msg = "הפעולה הושלמה בהצלחה!" & vbCrLf & vbCrLf & _
          "--- פירוט השינויים שבוצעו במסמך ---" & vbCrLf & _
          "* סימני פיסוק וכפילויות שניקו: " & cntPunctuation & vbCrLf & _
          "* תיקוני רווחים, סוגריים ומעברים: " & cntSpaces & vbCrLf & _
          "* שגיאות ואותיות סופיות שנצבעו באדום: " & cntRed & vbCrLf & _
          "* הדגשות שבוטלו (הוחזרו לצבע רגיל): " & cntClean & vbCrLf & _
          "----------------------------------------" & vbCrLf & _
          "סך כל השינויים שבוצעו במסמך: " & totalChanges
          
    MsgBox msg, vbInformation + vbMsgBoxRight + vbMsgBoxRtlReading, "דו""ח סיום תיקון מסמך"
End Sub
 
' פונקציית עזר פנימית קבועה ואמינה לספירה ולהחלפה מהירה במסמך (כולל הגנת מיקום)
Private Function FastReplaceAndCount(ByVal findText As String, ByVal replaceText As String, ByVal isWildcard As Boolean, Optional ByVal repColor As Long = -1) As Long
    Dim c As Long
    c = 0
    Selection.HomeKey Unit:=wdStory
    
    Dim lastPos As Long
    lastPos = -1
    
    ' שלב א: ספירת מופעים מוגנת
    With Selection.Find
        .ClearFormatting
        .Text = findText
        .MatchWildcards = isWildcard
        .Forward = True
        .Wrap = wdFindStop
        
        Do While .Execute
            If Selection.Start = lastPos Then Exit Do
            lastPos = Selection.Start
            c = c + 1
            Selection.Collapse wdCollapseEnd
        Loop
    End With
    
    ' שלב ב: ביצוע ההחלפה בפועל במידה ונמצאו מופעים
    If c > 0 Then
        Selection.HomeKey Unit:=wdStory
        With Selection.Find
            .ClearFormatting
            .Replacement.ClearFormatting
            .Text = findText
            .Replacement.Text = replaceText
            .MatchWildcards = isWildcard
            .Forward = True
            .Wrap = wdFindContinue
            If repColor <> -1 Then .Replacement.Font.Color = repColor
            .Execute Replace:=wdReplaceAll
        End With
    End If
    
    FastReplaceAndCount = c
End Function

Spoiler

1. ניקוי כפילויות של סימני פיסוק ואותיות
   בשלב הראשון, המאקרו עובר על המסמך ומנקה הקלדות כפולות ומיותרות:

נקודות כפולות: מחליף שתי נקודות רצופות (..) בנקודה אחת.

ריבוי נקודות: מחליף רצף של ארבע נקודות או יותר (....) בנקודה אחת (באמצעות זיהוי תבניות חכם).

פסיקים וגרשיים: מחליף פסיק כפול (,,) בפסיק בודד, ושני גרשיים רצופים ('') בגרש בודד.

אותיות סופיות כפולות: מחליף רצפים שגויים של אותיות סופיות (םם, ןן, ץץ, ףף, ךך) באות סופית אחת.

קיצור יודי"ם: מחליף שלושה יודי"ם רצופים (ייי) בשניים (יי).

2. סידור רווחים, סוגריים ומעברי שורה
   בשלב זה, המאקרו מטפל בנראות הכללית של הטקסט ומוודא שהריווח תקין:

הוספת רווחים חסרים: אם הוקלדה נקודה או פסיק ומיד אחריהם מילה (ללא רווח), המאקרו מפריד ביניהם ומוסיף את הרווח החסר.

הסרת רווחים לפני סימני פיסוק: מתקן שגיאות שבהן הוקלד רווח לפני נקודה, פסיק או גרש (לדוגמה: הופך , ל-, ).

ניקוי רווחים בתוך סוגריים: מוחק רווחים מיותרים שמופיעים מיד לאחר פתיחת סוגריים או רגע לפני סגירתם (הופך ( מילה ) ל-(מילה)).

ריווח חיצוני לסוגריים: מוודא שיש רווח תקני לפני פתיחת סוגריים ואחרי סגירת סוגריים (בתנאי שאין שם סימן פיסוק אחר).

מחיקת רווחים כפולים: סורק את כל המסמך ומצמצם כל רווח כפול לרווח אחד.

סידור אנטרים ומעברי שורה: מחליף שני אנטרים רצופים (פסקאות ריקות) באנטר אחד, ומוחק רווחים מיותרים שהוקלדו בטעות בדיוק לפני אנטר או לפני מעבר שורה ידני (Shift+Enter).

3. איתור שגיאות הקלדה והדגשתן באדום (בקרת איכות)
   המאקרו משמש כעורך לשוני שמתריע על מילים קטועות או שגיאות הקלדה נפוצות על ידי צביעתן באדום:

אות סופית בתחילת מילה: מזהה וצובע אות סופית (ם, ן, ץ, ף, ך) שהוקלדה מיד אחרי רווח.

אות סופית באמצע מילה: מזהה וצובע אות סופית שמיד אחריה הוקלדה אות רגילה (לדוגמה: המילה "שלוםם" תצבע את ה-'ם' הראשונה, או "עכשיןו").

אותיות בודדות וקטועות: מזהה אותיות בודדות שעומדות לבדן (רווח לפני ורווח או אנטר אחרי) וצובע אותן, כדי להתריע על מילה שנקטעה בטעות.

4. החזרת צבע רגיל למקרים לגיטימיים (ניקוי הדגשות)
   מכיוון שהשלב הקודם צובע כל אות בודדת, המאקרו חכם מספיק כדי לעבור שוב ולבטל את הצבע האדום (להחזיר לשחור/אוטומטי) עבור אותיות בודדות שהן תקינות לחלוטין בשפה העברית:

מסיר את הצבע מאותיות הקידומת או מילים בנות אות אחת: ן, ק, ה, ף, ת, ש, ג (למשל ה' הידיעה, ו' החיבור אם הוקלדה בטעות כבודדת, וכד').

מסיר את הצבע מגרש בודד שמגיע אחרי אותיות.

5. סנכרון ותיקון עיצוב סוגריים (טיפול בבאג של Word)
   המאקרו סורק מחדש את כל המסמך ומחפש כל תו של סוגריים עגולים () או מרובעים [].

עבור כל סוגר שהוא מוצא, הוא "מסתכל" על האות העברית שצמודה אליו וקורא את סוג הגופן שלה (למשל: פרנק-ריל, דוד, נרקיסים).

הוא "מכריח" את הסוגריים לקבל בדיוק את אותו הגופן העברי, ובכך מונע את התופעה שבה הסוגריים "קופצים" לעיצוב אנגלי (כמו Arial) ונראים מנותקים, עבים או לא שייכים לטקסט.

עריכה:
הקוד החדש נערך ותוקן

[דאנציג]

@יאיר-דניאל
אצלי הקוד החדש נכנס לLOOP אין סופי.

[יאיר דניאל]

@דאנציג איזה גודל קובץ?
כי אצלי עובד מצויין.
אבל שמת לב שיש בו כמה אי דיוקים קטנים.
אם יהיה לי זמן אעבוד על זה בלילה

[דאנציג]

@יאיר-דניאל כתב בשיתוף | המשך - "מתעדכן" אוסף מאקרו לוורד - אינדקס מאקרו שימושי + הוראות חשובות.:

איזה גודל קובץ?

57 עמו'

[שאלתיאל]

מאקרו להחלת טור אחד לפי סגנון

צריך לפני זה להחיל 2 טורים על כל המסמך ולאחר מכן המאקרו מחזיר את הפיסקאות הרצויות לטור אחד,
בתחילת המאקרו נפתחת חלונית בה בוחרים את הסגנונות הרצויים, ניתן לבחור מספר סגנונות במקביל, לאחר מכן המאקרו מוסיף מעבר מקטע רציף לפני ואחרי כל פיסקה בסגנונות שנבחרו ומחיל עליהם הגדרה של טור אחד, אם יש שני פיסקאות רצופות בסגנונות שנבחרו הוא לא מוסיף מעבר מקטע ביניהם.
מומלץ אחר כך להחליף את כל המעברי מקטע לסגנון רגיל.
המאקרו כאן החלת טור אחד לפי סגנון.docm

Spoiler

המאקרו נערך כשעה אחרי שהועלה, יש להורידו שוב