שיתוף | המשך - "מתעדכן" אוסף מאקרו לוורד - אינדקס מאקרו שימושי + הוראות חשובות.
-
מאקרו קטן שכתבתי (בעזרת ה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 - כי פשוט קצת הסתבכתי לבד...)
לגיבוי של כל ההגדרות האישיות באופיס, כמו תיקוני שגיאות, תבנית נורמל, מילון, פקודות המאקרו ועיצוב הכרטיסיות שלכם.
זהו מאקרו כפול - גיבוי, ושחזור למיקום המקורי.
זה חשוב לגבות מידי פעם, מנסיון...- התיקייה שתיווצר לאחר הרצת המאקרו - לא שוקלת כמעט כלום, אבל היא תחסוך לכם הרבה עבודה - כשיימחק לכם ההגדרות איכשהו/ תאפסו את המחשב/ תעשו התקנה נקייה/ תקנו מחשב חדש!
מאקרו גיבוי תבנית נורמל:
[זה מאקרו שכתב אי מי מחברי הפורום, אינני זוכר מי כך שאני לא יכול לתת לו את הקרדיט המגיע לו - לגיבוי של תבנית הנורמל
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 - כי פשוט קצת הסתבכתי לבד...)
לגיבוי של כל ההגדרות האישיות באופיס, כמו תיקוני שגיאות, תבנית נורמל, מילון, פקודות המאקרו ועיצוב הכרטיסיות שלכם.האם זה שומר גם על כל הכרטיסיות, הקיצורי דרך, והמאקרואים.
-
@יאיר-דניאל כתב בשיתוף | המשך - "מתעדכן" אוסף מאקרו לוורד - אינדקס מאקרו שימושי + הוראות חשובות.:
הנה מאקרו קטן שכתבתי (בעזרת ה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
גירסה ב:
בחירת גופן להחלפה - מתוך רשימה
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זה עובד כך - תמונות בספויילר



גירסה ג:
(כמו גירסה ב' אבל לא צריך להקליד מספר גופן - אלא בוחרים בגופן עצמו - ההמשך אותו דבר).
פשוט להפעיל את הקובץ המצורף
החלפת גופנים.exeאו להכניס את הקובץ המצורף- לתיקיית הטמפלס של אופיס
(הקובץ למעלה
- עושה את זה אוטומטית)
-
מאקרו תיקון סמינים כפולים ושגיאות הקלדה
(פירוט הפעולות שנעשות ע"י המאקרו - בספויילר בסוף ההודעה)
העליתי בעבר מאקרו לתיקון סימנים כפולים ושגיאות הקלדה - משהו שיצרתי לאט לאט - תוכ"ד כתיבה ושימת לב לשגיאות נפוצות, הבעיה היא שהוא לא היה כתוב נכון, מכיון שהוא גרם לוורד לעשות כל פעולת החלפה - על כל המסמך ואז שוב - ההחלפה הבאה, מהתחלה ועד הסוף, מה שיצר גם קוד ארוך במיוחד.
הנה הוא, סתם לשם התרשמות:
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 arrFind As Variant, arrRep As Variant ' --- קטגוריה 1: סימני פיסוק וכפילויות --- arrFind = Array("..", ",,", "''", "ייי", "םם", "ןן", "ץץ", "ףף", "ךך") arrRep = Array(".", ",", "'", "יי", "ם", "ן", "ץ", "ף", "ך") For i = LBound(arrFind) To UBound(arrFind) cntPunctuation = cntPunctuation + FastReplaceAndCount(CStr(arrFind(i)), CStr(arrRep(i)), False) Next i cntPunctuation = cntPunctuation + FastReplaceAndCount(".{4,}", ".", True) ' --- קטגוריה 2: תיקוני רווחים, סוגריים ומעברים --- cntSpaces = cntSpaces + FastReplaceAndCount(".?[! ]", "@@^&", True) cntSpaces = cntSpaces + FastReplaceAndCount("@@.", ". ", False) cntSpaces = cntSpaces + FastReplaceAndCount(",?[! ]", "@@^&", True) cntSpaces = cntSpaces + FastReplaceAndCount("@@,", ", ", False) arrFind = Array(" . ", " , ", " ' ", " ,", " .", ", (", ". [", ", [", "[ ", " ]", "( ", " )", _ " ) ", " ( ", "' .", "' ,", "' ]", " ", "^p^p", " ^p", "^l [", " ^l [") arrRep = Array(". ", ", ", "' ", ",", ".", " (", " [", " [", "[", "]", "(", ")", _ " (", ") ", "'.", "',", "']", " ", "^p", "^p", "^l[", "^l[") For i = LBound(arrFind) To UBound(arrFind) cntSpaces = cntSpaces + FastReplaceAndCount(CStr(arrFind(i)), CStr(arrRep(i)), False) Next i ' הוספת רווחים אחרי נקודה/פסיק וסביב סוגריים באמצעות תווים כלליים cntSpaces = cntSpaces + FastReplaceAndCount("(.)([! ^13])", "\1 \2", True) cntSpaces = cntSpaces + FastReplaceAndCount("(,)([! ^13])", "\1 \2", True) cntSpaces = cntSpaces + FastReplaceAndCount("([! ^13'""])([(\[])", "\1 \2", True) cntSpaces = cntSpaces + FastReplaceAndCount("([)\]])([! ^13.,'""\?\!])", "\1 \2", True) ' טיפול ברווחים כפולים או מיוחדים עם שטרודל cntSpaces = cntSpaces + FastReplaceAndCount("^$. )", "^&@@", False) cntSpaces = cntSpaces + FastReplaceAndCount(" )@@", ")", False) cntSpaces = cntSpaces + FastReplaceAndCount("""""^$", "@@^&", False) cntSpaces = cntSpaces + FastReplaceAndCount("@@""""", """", False) ' --- קטגוריה 3: אותיות ושגיאות שנצבעו באדום --- arrFind = Array(" ם", " ן", " ץ", " ף", " ך", """^$'") For i = LBound(arrFind) To UBound(arrFind) cntRed = cntRed + FastReplaceAndCount(CStr(arrFind(i)), "^&", False, wdColorRed) Next i arrFind = Array("ם[א-ת]", "ן[א-ת]", "ץ[א-ת]", "ף[א-ת]", "ך[א-ת]", " [א-ת] ", " [א-ת]^13") For i = LBound(arrFind) To UBound(arrFind) cntRed = cntRed + FastReplaceAndCount(CStr(arrFind(i)), "^&", True, wdColorRed) Next i ' --- קטגוריה 4: תיקוני הדגשות (החזרה לצבע אוטומטי) --- arrFind = Array("ן [א-ת] ", "ק [א-ת] ", "ה [א-ת] ", "ף [א-ת] ", "ת [א-ת] ", "ש [א-ת] ", "ג [א-ת] ", "' [א-ת] ", _ "ן [א-ת]^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 Bug Fix) --- Selection.HomeKey Unit:=wdStory With Selection.Find .ClearFormatting .Text = "[\(\)\[\]]" .MatchWildcards = True .Wrap = wdFindStop Do While .Execute 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 ' שלב א: ספירת מופעים With Selection.Find .ClearFormatting .Text = findText .MatchWildcards = isWildcard .Forward = True .Wrap = wdFindStop Do While .Execute 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
- ניקוי כפילויות של סימני פיסוק ואותיות
בשלב הראשון, המאקרו עובר על המסמך ומנקה הקלדות כפולות ומיותרות:
נקודות כפולות: מחליף שתי נקודות רצופות (..) בנקודה אחת.
ריבוי נקודות: מחליף רצף של ארבע נקודות או יותר (....) בנקודה אחת (באמצעות זיהוי תבניות חכם).
פסיקים וגרשיים: מחליף פסיק כפול (,,) בפסיק בודד, ושני גרשיים רצופים ('') בגרש בודד.
אותיות סופיות כפולות: מחליף רצפים שגויים של אותיות סופיות (םם, ןן, ץץ, ףף, ךך) באות סופית אחת.
קיצור יודי"ם: מחליף שלושה יודי"ם רצופים (ייי) בשניים (יי).
- סידור רווחים, סוגריים ומעברי שורה
בשלב זה, המאקרו מטפל בנראות הכללית של הטקסט ומוודא שהריווח תקין:
הוספת רווחים חסרים: אם הוקלדה נקודה או פסיק ומיד אחריהם מילה (ללא רווח), המאקרו מפריד ביניהם ומוסיף את הרווח החסר.
הסרת רווחים לפני סימני פיסוק: מתקן שגיאות שבהן הוקלד רווח לפני נקודה, פסיק או גרש (לדוגמה: הופך , ל-, ).
ניקוי רווחים בתוך סוגריים: מוחק רווחים מיותרים שמופיעים מיד לאחר פתיחת סוגריים או רגע לפני סגירתם (הופך ( מילה ) ל-(מילה)).
ריווח חיצוני לסוגריים: מוודא שיש רווח תקני לפני פתיחת סוגריים ואחרי סגירת סוגריים (בתנאי שאין שם סימן פיסוק אחר).
מחיקת רווחים כפולים: סורק את כל המסמך ומצמצם כל רווח כפול לרווח אחד.
סידור אנטרים ומעברי שורה: מחליף שני אנטרים רצופים (פסקאות ריקות) באנטר אחד, ומוחק רווחים מיותרים שהוקלדו בטעות בדיוק לפני אנטר או לפני מעבר שורה ידני (Shift+Enter).
- איתור שגיאות הקלדה והדגשתן באדום (בקרת איכות)
המאקרו משמש כעורך לשוני שמתריע על מילים קטועות או שגיאות הקלדה נפוצות על ידי צביעתן באדום:
אות סופית בתחילת מילה: מזהה וצובע אות סופית (ם, ן, ץ, ף, ך) שהוקלדה מיד אחרי רווח.
אות סופית באמצע מילה: מזהה וצובע אות סופית שמיד אחריה הוקלדה אות רגילה (לדוגמה: המילה "שלוםם" תצבע את ה-'ם' הראשונה, או "עכשיןו").
אותיות בודדות וקטועות: מזהה אותיות בודדות שעומדות לבדן (רווח לפני ורווח או אנטר אחרי) וצובע אותן, כדי להתריע על מילה שנקטעה בטעות.
- החזרת צבע רגיל למקרים לגיטימיים (ניקוי הדגשות)
מכיוון שהשלב הקודם צובע כל אות בודדת, המאקרו חכם מספיק כדי לעבור שוב ולבטל את הצבע האדום (להחזיר לשחור/אוטומטי) עבור אותיות בודדות שהן תקינות לחלוטין בשפה העברית:
מסיר את הצבע מאותיות הקידומת או מילים בנות אות אחת: ן, ק, ה, ף, ת, ש, ג (למשל ה' הידיעה, ו' החיבור אם הוקלדה בטעות כבודדת, וכד').
מסיר את הצבע מגרש בודד שמגיע אחרי אותיות.
- סנכרון ותיקון עיצוב סוגריים (טיפול בבאג של Word)
המאקרו סורק מחדש את כל המסמך ומחפש כל תו של סוגריים עגולים () או מרובעים [].
עבור כל סוגר שהוא מוצא, הוא "מסתכל" על האות העברית שצמודה אליו וקורא את סוג הגופן שלה (למשל: פרנק-ריל, דוד, נרקיסים).
הוא "מכריח" את הסוגריים לקבל בדיוק את אותו הגופן העברי, ובכך מונע את התופעה שבה הסוגריים "קופצים" לעיצוב אנגלי (כמו Arial) ונראים מנותקים, עבים או לא שייכים לטקסט.
- ניקוי כפילויות של סימני פיסוק ואותיות
-
מאקרו תיקון סמינים כפולים ושגיאות הקלדה
(פירוט הפעולות שנעשות ע"י המאקרו - בספויילר בסוף ההודעה)
העליתי בעבר מאקרו לתיקון סימנים כפולים ושגיאות הקלדה - משהו שיצרתי לאט לאט - תוכ"ד כתיבה ושימת לב לשגיאות נפוצות, הבעיה היא שהוא לא היה כתוב נכון, מכיון שהוא גרם לוורד לעשות כל פעולת החלפה - על כל המסמך ואז שוב - ההחלפה הבאה, מהתחלה ועד הסוף, מה שיצר גם קוד ארוך במיוחד.
הנה הוא, סתם לשם התרשמות:
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 arrFind As Variant, arrRep As Variant ' --- קטגוריה 1: סימני פיסוק וכפילויות --- arrFind = Array("..", ",,", "''", "ייי", "םם", "ןן", "ץץ", "ףף", "ךך") arrRep = Array(".", ",", "'", "יי", "ם", "ן", "ץ", "ף", "ך") For i = LBound(arrFind) To UBound(arrFind) cntPunctuation = cntPunctuation + FastReplaceAndCount(CStr(arrFind(i)), CStr(arrRep(i)), False) Next i cntPunctuation = cntPunctuation + FastReplaceAndCount(".{4,}", ".", True) ' --- קטגוריה 2: תיקוני רווחים, סוגריים ומעברים --- cntSpaces = cntSpaces + FastReplaceAndCount(".?[! ]", "@@^&", True) cntSpaces = cntSpaces + FastReplaceAndCount("@@.", ". ", False) cntSpaces = cntSpaces + FastReplaceAndCount(",?[! ]", "@@^&", True) cntSpaces = cntSpaces + FastReplaceAndCount("@@,", ", ", False) arrFind = Array(" . ", " , ", " ' ", " ,", " .", ", (", ". [", ", [", "[ ", " ]", "( ", " )", _ " ) ", " ( ", "' .", "' ,", "' ]", " ", "^p^p", " ^p", "^l [", " ^l [") arrRep = Array(". ", ", ", "' ", ",", ".", " (", " [", " [", "[", "]", "(", ")", _ " (", ") ", "'.", "',", "']", " ", "^p", "^p", "^l[", "^l[") For i = LBound(arrFind) To UBound(arrFind) cntSpaces = cntSpaces + FastReplaceAndCount(CStr(arrFind(i)), CStr(arrRep(i)), False) Next i ' הוספת רווחים אחרי נקודה/פסיק וסביב סוגריים באמצעות תווים כלליים cntSpaces = cntSpaces + FastReplaceAndCount("(.)([! ^13])", "\1 \2", True) cntSpaces = cntSpaces + FastReplaceAndCount("(,)([! ^13])", "\1 \2", True) cntSpaces = cntSpaces + FastReplaceAndCount("([! ^13'""])([(\[])", "\1 \2", True) cntSpaces = cntSpaces + FastReplaceAndCount("([)\]])([! ^13.,'""\?\!])", "\1 \2", True) ' טיפול ברווחים כפולים או מיוחדים עם שטרודל cntSpaces = cntSpaces + FastReplaceAndCount("^$. )", "^&@@", False) cntSpaces = cntSpaces + FastReplaceAndCount(" )@@", ")", False) cntSpaces = cntSpaces + FastReplaceAndCount("""""^$", "@@^&", False) cntSpaces = cntSpaces + FastReplaceAndCount("@@""""", """", False) ' --- קטגוריה 3: אותיות ושגיאות שנצבעו באדום --- arrFind = Array(" ם", " ן", " ץ", " ף", " ך", """^$'") For i = LBound(arrFind) To UBound(arrFind) cntRed = cntRed + FastReplaceAndCount(CStr(arrFind(i)), "^&", False, wdColorRed) Next i arrFind = Array("ם[א-ת]", "ן[א-ת]", "ץ[א-ת]", "ף[א-ת]", "ך[א-ת]", " [א-ת] ", " [א-ת]^13") For i = LBound(arrFind) To UBound(arrFind) cntRed = cntRed + FastReplaceAndCount(CStr(arrFind(i)), "^&", True, wdColorRed) Next i ' --- קטגוריה 4: תיקוני הדגשות (החזרה לצבע אוטומטי) --- arrFind = Array("ן [א-ת] ", "ק [א-ת] ", "ה [א-ת] ", "ף [א-ת] ", "ת [א-ת] ", "ש [א-ת] ", "ג [א-ת] ", "' [א-ת] ", _ "ן [א-ת]^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 Bug Fix) --- Selection.HomeKey Unit:=wdStory With Selection.Find .ClearFormatting .Text = "[\(\)\[\]]" .MatchWildcards = True .Wrap = wdFindStop Do While .Execute 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 ' שלב א: ספירת מופעים With Selection.Find .ClearFormatting .Text = findText .MatchWildcards = isWildcard .Forward = True .Wrap = wdFindStop Do While .Execute 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
- ניקוי כפילויות של סימני פיסוק ואותיות
בשלב הראשון, המאקרו עובר על המסמך ומנקה הקלדות כפולות ומיותרות:
נקודות כפולות: מחליף שתי נקודות רצופות (..) בנקודה אחת.
ריבוי נקודות: מחליף רצף של ארבע נקודות או יותר (....) בנקודה אחת (באמצעות זיהוי תבניות חכם).
פסיקים וגרשיים: מחליף פסיק כפול (,,) בפסיק בודד, ושני גרשיים רצופים ('') בגרש בודד.
אותיות סופיות כפולות: מחליף רצפים שגויים של אותיות סופיות (םם, ןן, ץץ, ףף, ךך) באות סופית אחת.
קיצור יודי"ם: מחליף שלושה יודי"ם רצופים (ייי) בשניים (יי).
- סידור רווחים, סוגריים ומעברי שורה
בשלב זה, המאקרו מטפל בנראות הכללית של הטקסט ומוודא שהריווח תקין:
הוספת רווחים חסרים: אם הוקלדה נקודה או פסיק ומיד אחריהם מילה (ללא רווח), המאקרו מפריד ביניהם ומוסיף את הרווח החסר.
הסרת רווחים לפני סימני פיסוק: מתקן שגיאות שבהן הוקלד רווח לפני נקודה, פסיק או גרש (לדוגמה: הופך , ל-, ).
ניקוי רווחים בתוך סוגריים: מוחק רווחים מיותרים שמופיעים מיד לאחר פתיחת סוגריים או רגע לפני סגירתם (הופך ( מילה ) ל-(מילה)).
ריווח חיצוני לסוגריים: מוודא שיש רווח תקני לפני פתיחת סוגריים ואחרי סגירת סוגריים (בתנאי שאין שם סימן פיסוק אחר).
מחיקת רווחים כפולים: סורק את כל המסמך ומצמצם כל רווח כפול לרווח אחד.
סידור אנטרים ומעברי שורה: מחליף שני אנטרים רצופים (פסקאות ריקות) באנטר אחד, ומוחק רווחים מיותרים שהוקלדו בטעות בדיוק לפני אנטר או לפני מעבר שורה ידני (Shift+Enter).
- איתור שגיאות הקלדה והדגשתן באדום (בקרת איכות)
המאקרו משמש כעורך לשוני שמתריע על מילים קטועות או שגיאות הקלדה נפוצות על ידי צביעתן באדום:
אות סופית בתחילת מילה: מזהה וצובע אות סופית (ם, ן, ץ, ף, ך) שהוקלדה מיד אחרי רווח.
אות סופית באמצע מילה: מזהה וצובע אות סופית שמיד אחריה הוקלדה אות רגילה (לדוגמה: המילה "שלוםם" תצבע את ה-'ם' הראשונה, או "עכשיןו").
אותיות בודדות וקטועות: מזהה אותיות בודדות שעומדות לבדן (רווח לפני ורווח או אנטר אחרי) וצובע אותן, כדי להתריע על מילה שנקטעה בטעות.
- החזרת צבע רגיל למקרים לגיטימיים (ניקוי הדגשות)
מכיוון שהשלב הקודם צובע כל אות בודדת, המאקרו חכם מספיק כדי לעבור שוב ולבטל את הצבע האדום (להחזיר לשחור/אוטומטי) עבור אותיות בודדות שהן תקינות לחלוטין בשפה העברית:
מסיר את הצבע מאותיות הקידומת או מילים בנות אות אחת: ן, ק, ה, ף, ת, ש, ג (למשל ה' הידיעה, ו' החיבור אם הוקלדה בטעות כבודדת, וכד').
מסיר את הצבע מגרש בודד שמגיע אחרי אותיות.
- סנכרון ותיקון עיצוב סוגריים (טיפול בבאג של Word)
המאקרו סורק מחדש את כל המסמך ומחפש כל תו של סוגריים עגולים () או מרובעים [].
עבור כל סוגר שהוא מוצא, הוא "מסתכל" על האות העברית שצמודה אליו וקורא את סוג הגופן שלה (למשל: פרנק-ריל, דוד, נרקיסים).
הוא "מכריח" את הסוגריים לקבל בדיוק את אותו הגופן העברי, ובכך מונע את התופעה שבה הסוגריים "קופצים" לעיצוב אנגלי (כמו Arial) ונראים מנותקים, עבים או לא שייכים לטקסט.
- ניקוי כפילויות של סימני פיסוק ואותיות
-
@יאיר-דניאל
אצלי הקוד החדש נכנס לLOOP אין סופי.@דאנציג איזה גודל קובץ?
כי אצלי עובד מצויין.
אבל שמת לב שיש בו כמה אי דיוקים קטנים.
אם יהיה לי זמן אעבוד על זה בלילה