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

[יאיר דניאל]

@pcinfogmach מצורף מאקרו תיקון שגיאות - קצת שונה ממה שכבר העלת כאן מ @א.מ
מכיוון שאני לא יודע איך סוגרים אותו, וגם בכדי שיכולו לעבור עליו - אני מצרף אותו גם בתוך קובץ TXT.
(יש שם כמה דברים שמיועדים למי שמשתמש עם תיקון שגיאות אוטומטי (https://mitmachim.top/topic/78023/להורדה-תיקון-שגיאות-אוטומטי-בוורד/19)

תיקון סימנים כפולים.txt

Spoiler

||Sub תיקון_סימנים_כפולים()
'
' תיקון_סימנים_כפולים Macro
'
'
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = ".."
.Replacement.Text = "."
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchKashida = False
.MatchDiacritics = False
.MatchAlefHamza = False
.MatchControl = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.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.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 Wit
Selection.Find.Execute Replace:=wdReplaceAll

||ספויילר

אשמח לשיפורים, הערות, והארות

[שלמה11]

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

Sub הסרת_הצבעים_המיוחדים()
On Error GoTo ErrorHandler ' הפעלת טיפול בשגיאות
Dim doc As Document
Dim rng As Range
Dim i As Integer
Dim word As Range

' קבלת המסמך הפעיל
Set doc = ActiveDocument

' מעבר על כל המילים במסמך
For Each rng In doc.StoryRanges
    Do
        For Each word In rng.Words
            ' אם הצבע אדום בהיר או ירוק בהיר, נסיר אותו
            If word.font.Color = RGB(1, 255, 1) Or word.font.Color = RGB(255, 1, 1) Then
                word.font.Color = wdColorAutomatic
            End If
        Next word
        Set rng = rng.NextStoryRange
    Loop While Not rng Is Nothing
Next rng

אני התכוונתי לזה:

Sub FindGreenAndRedText()
    ' חיפוש טקסט בצבע ירוק
    With Selection.Find
        .ClearFormatting
        .Font.Color = RGB(1, 255, 1)
        .Text = ""
        .Replacement.Text = ""
        .Wrap = wdFindContinue
        .Format = True
        .Execute Replace:=wdReplaceNone
    End With

    ' חיפוש טקסט בצבע אדום
    With Selection.Find
        .ClearFormatting
        .Font.Color = RGB(255, 1, 1)
        .Text = ""
        .Replacement.Text = ""
        .Wrap = wdFindContinue
        .Format = True
        .Execute Replace:=wdReplaceNone
    End With
End Sub

[יאיר דניאל]

איך עושים בחיפוש והחלפה, תיקון לשגיאות הבאות:
,א = אם יש פסיק ואז אות, שירד הפסיק לפני האות ויהיה אחריה.
שלום(וברכה) = אם התו הפותח של סוגריים, צמוד למילה הקודמת - איך מכניסים ריווח לפני הסוגריים [החלף: "^$(" ב: "^& (" גורם שהתוצאה תהיה כך: "( (" ]
שלום.(וברכה) = אם התו הפותח של סוגריים, צמוד לנקודה או פסיק - איך מכניסים ריווח לפני הסוגריים.
שלום)וברכה = אם התו הסוגר של סוגריים, צמוד למילה הבאה - איך מכניסין ריווח אחרי הסוגריים.

[יאיר דניאל]

עשיתי מאקרו תיקון שגיאות (ראה לעיל https://mitmachim.top/topic/51883/שיתוף-מתעדכן-אוסף-מאקרו-לוורד-אינדקס-מאקרו-שימושי-הוראות-חשובות/208?_=1737235546512)

• איך עושים שבסוף התיקון יפתח לי חלון ובו יופיע כמה תיקונים נעשו במסמך, ואיזה תיקונים?
  הצלחתי להגיע למצב הזה-

(העתקתי את הפקודה הזו מהאמקרו של "קיצורי מקשים מותאמים אישית")

• 

אבל איך אני גורם לו לכתוב אלו תיקונים נעשו.

• נ.ב. האם ישנה אפשרות לבטל\לאפשר חלונית זו לפי בחירה, או רק ע"י מחיקת הפקודה הזו מתוך המאקרו?

• נ.ב.ב איך אני גורם להודעה להופיע למספר שניות ולאחמ"כ להיעלם בלי שאצטרך ללחוץ על אישור?
  תודה רבה!

[pcinfogmach]

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

נ.ב.ב איך אני גורם להודעה להופיע למספר שניות ולאחמ"כ להיעלם בלי שאצטרך ללחוץ על אישור?
תודה רבה!

אתה יכול לייצר userform ולהשתמש בו בצורה של modless
https://bettersolutions.com/vba/userforms/modeless.htm

מחפש מדריך ארוך יותר על הנושא של userform עיין כאן:
https://excelmacromastery.com/vba-userform/comment-page-1/

[pcinfogmach]

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

איך עושים שבסוף התיקון יפתח לי חלון ובו יופיע כמה תיקונים נעשו במסמך, ואיזה תיקונים?

עיין כאן
https://stackoverflow.com/a/52868742

העיקרון הוא להשתמש עם לולאת חיפוש אבל יש לזה מחיר באיטיות

[יאיר דניאל]

@pcinfogmach תודה, אבל האמת לא התקדמתי כלום...
הכל שם באנגלית והתרגום של גוגל לא מספק, כך שלא הצלחתי להסתדר.
אשמח אם יש למישהו הדרכה בעברית

• או אם יש מישהו שיוכל לכתוב לי את הפקודה למאקרו,, ולעלות את זה כאן.

[u88]

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

[u88]

@u88 ===group
זה מה שהיה שם

Sub Demo()
Application.ScreenUpdating = False
Dim i As Long
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = InputBox("What is the Text to Find")
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
    .Execute
  End With
  Do While .Find.Found
    i = i + 1
    .Collapse wdCollapseEnd
    .Find.Execute
  Loop
End With
Application.ScreenUpdating = True
MsgBox i & " instances found."
End Sub

[יאיר דניאל]

@u88 אני יודע, וזה בדיוק מה שאני שואל, איך אני מזין לו שיבדוק ויציג לי את כל התיקונים שנעשו ע"י המאקרו שלי

[יאיר דניאל]

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

זה מה שהיה שם

איפה זה שם?

[u88]

@יאיר-דניאל באתר ש@pcinfogmach הביא לך

[יאיר דניאל]

@u88 לא הבנתי מה אתה רוצה.
בכ"א אני צריך משהו ספציפי, ואשמח אם מישהו יוכל לעזור לי:
איך אני כותב פקודת מאקרו שתציג לי (בהודעה, כך:

את כל השינויים שנעשו במסמך - ע"י המאקרו של תיקון שגיאות שהעלתי למעלה.
אולי @pcinfogmach יוכל לעזור?

[pcinfogmach]

@יאיר-דניאל
אתה מתכוויןלשאול איך כותבים את המאקרו? או שאתה מתכווין לבקש שמישהו יעשה לך את העבודה ויכתוב לך את המאקרו?

[מניין]

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

@u88 לא הבנתי מה אתה רוצה.
בכ"א אני צריך משהו ספציפי, ואשמח אם מישהו יוכל לעזור לי:
איך אני כותב פקודת מאקרו שתציג לי (בהודעה, כך:

את כל השינויים שנעשו במסמך - ע"י המאקרו של תיקון שגיאות שהעלתי למעלה.
אולי @pcinfogmach יוכל לעזור?

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

Sub תיקון_סימנים_כפולים()
    Dim תיקונים As String
    Dim נמצא_תיקון As Boolean
    Dim מספר_תיקונים As Long
    Dim מספר_תיקונים_כולל As Long
    
    ' אתחול
    תיקונים = "תיקונים שבוצעו:" & vbCrLf
    נמצא_תיקון = False
    מספר_תיקונים_כולל = 0

    ' ביצוע התיקונים
    מספר_תיקונים = בצע_חיפוש_והחלפה("..", ".")
    If מספר_תיקונים > 0 Then
        תיקונים = תיקונים & "הוחלף '..' ב- '.' - " & מספר_תיקונים & " פעמים" & vbCrLf
        נמצא_תיקון = True
        מספר_תיקונים_כולל = מספר_תיקונים_כולל + מספר_תיקונים
    End If

    מספר_תיקונים = בצע_חיפוש_והחלפה(",,", ",")
    If מספר_תיקונים > 0 Then
        תיקונים = תיקונים & "הוחלף ',,' ב- ',' - " & מספר_תיקונים & " פעמים" & vbCrLf
        נמצא_תיקון = True
        מספר_תיקונים_כולל = מספר_תיקונים_כולל + מספר_תיקונים
    End If

    מספר_תיקונים = בצע_חיפוש_והחלפה("''", "'")
    If מספר_תיקונים > 0 Then
        תיקונים = תיקונים & "הוחלף '''' ב- ''' - " & מספר_תיקונים & " פעמים" & vbCrLf
        נמצא_תיקון = True
        מספר_תיקונים_כולל = מספר_תיקונים_כולל + מספר_תיקונים
    End If

    מספר_תיקונים = בצע_חיפוש_והחלפה("""""", """")
    If מספר_תיקונים > 0 Then
        תיקונים = תיקונים & "הוחלף '""""' ב- '''' - " & מספר_תיקונים & " פעמים" & vbCrLf
        נמצא_תיקון = True
        מספר_תיקונים_כולל = מספר_תיקונים_כולל + מספר_תיקונים
    End If

    מספר_תיקונים = בצע_חיפוש_והחלפה("  ", " ")
    If מספר_תיקונים > 0 Then
        תיקונים = תיקונים & "הוחלף '  ' ב- ' ' - " & מספר_תיקונים & " פעמים" & vbCrLf
        נמצא_תיקון = True
        מספר_תיקונים_כולל = מספר_תיקונים_כולל + מספר_תיקונים
    End If

    מספר_תיקונים = בצע_חיפוש_והחלפה(" ,", ",")
    If מספר_תיקונים > 0 Then
        תיקונים = תיקונים & "הוחלף ' ,' ב- ',' - " & מספר_תיקונים & " פעמים" & vbCrLf
        נמצא_תיקון = True
        מספר_תיקונים_כולל = מספר_תיקונים_כולל + מספר_תיקונים
    End If

    מספר_תיקונים = בצע_חיפוש_והחלפה(" .", ".")
    If מספר_תיקונים > 0 Then
        תיקונים = תיקונים & "הוחלף ' .' ב- '.' - " & מספר_תיקונים & " פעמים" & vbCrLf
        נמצא_תיקון = True
        מספר_תיקונים_כולל = מספר_תיקונים_כולל + מספר_תיקונים
    End If

    ' הודעת סיכום
    If נמצא_תיקון And מספר_תיקונים_כולל > 0 Then
        MsgBox תיקונים, vbInformation, "סיכום תיקונים"
    Else
        MsgBox "לא בוצעו תיקונים במסמך.", vbInformation, "סיכום תיקונים"
    End If
End Sub

Function בצע_חיפוש_והחלפה(טקסט_לחיפוש As String, טקסט_להחלפה As String) As Long
    Dim מספר_החלפות As Long
    מספר_החלפות = 0
    
    With Selection.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = טקסט_לחיפוש
        .Replacement.Text = טקסט_להחלפה
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
    End With
    
    Do While Selection.Find.Execute(Replace:=wdReplaceOne)
        מספר_החלפות = מספר_החלפות + 1
    Loop
    
    בצע_חיפוש_והחלפה = מספר_החלפות
End Function

[אלכסון]

@מניין רק הערה, בד"כ כשמחפשים נקודה כפולה צריך לנסח כך: ..?[!.] כי מצוי מאד השימוש בשלוש נקודות.

[יאיר דניאל]

@מניין תודה

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

שאר הפקודות פשוט לא הבנתי מה הם עושים.

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

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

[מניין]

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

@מניין תודה

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

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

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

[pcinfogmach]

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

@מניין רק הערה, בד"כ כשמחפשים נקודה כפולה צריך לנסח כך: ..?[!.] כי מצוי מאד השימוש בשלוש נקודות.

אם כבר אז כך:

.{1,}

[menajemmendel]

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

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

@מניין רק הערה, בד"כ כשמחפשים נקודה כפולה צריך לנסח כך: ..?[!.] כי מצוי מאד השימוש בשלוש נקודות.

אם כבר אז כך:

.{1,}

נראה לי שהוא התכוון בדוקא למה שכתב, שבמקום שכתב 3 נקודות רוצה שישארו 3,