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

[menajemmendel]

@pcinfogmach אני אישית משתמש בשיטה אחרת (לדעתי יותר טובה, לולאה, שבודקת אם הטקטס בשורה הזו נמוך מבחינת גובה יותר מהטקסט בשורה הקודמת)

[menajemmendel]

המאקרו שישים סוף לעוגמת הנפש – סידור מילים בסדר עולה!

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

הבעיה הידועה:

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

כמה פעמים אמרתם לעצמכם:

• "למה המילים האלה לא מסודרות בצורה נורמלית?"
• "איך אני אמור לקרוא את זה?"
• "איזו עוגמת נפש!"
• מישהו שולח לכם חידוש תורה, ואתם שואלים את עצמכם: "למה 'מצווה' מגיעה לפני 'ברכה'? זה לא הגיוני!"

הפתרון – המאקרו החדש שלי!

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

איך זה עובד?
זה פשוט גאוני – המאקרו משתמש באלגוריתם ה"בועה" (Bubble Sort), הידוע כאלגוריתם שמביא סדר לעולם, ומסדר את המילים שלכם כמו שחלמתם.
דוגמאות לשימושים מעשיים:
• סידור כתבות מבולגנות מהעיתון.
• מיון חידושי תורה כך שגם החברותא שלכם יבין מה קורה.
• סידור מכתבים מחברים כדי שתוכלו סוף סוף להבין מה הם רוצים להגיד.

תגובות נרגשות מהשטח:

"סידור המילים שינה לי את החיים. סוף סוף אני יכול לקרוא בלי להתרגז."
"חשבתי שבלגן בטקסטים זה גזירת גורל, אבל המאקרו הזה פתח לי את העיניים."
"Bubble Sort? יותר כמו Life Sort! החיים שלי מסודרים עכשיו."
"זה לא רק כלי, זה פילוסופיית חיים. כל המילים במקום אחד – מדהים."
"מאז שסידרתי את רשימת המכולת שלי, הכל מרגיש טוב יותר."

למי שאין את המאקרו הזה:

• תמשיכו להתמודד עם טקסטים מבולגנים ועצבים מיותרים.
• לעולם לא תחוו את השלווה של טקסט מסודר.
• והכי גרוע – איך תסבירו לחברים שלכם שאין לכם כלי כזה?

️ אז למה אתם מחכים?

הגיע הזמן לשים סוף לבלגן! תתקינו את הקוד, סדרו את המילים שלכם, ותצאו לחופשי!
אגב אני רוצה להדגיש שכמה שהמאקרוים שלי נראים יפים להפליא הם פרי יצירתי ולא ממו''ר GPT, פשוט לאחרונה רכשתי קורס של VBA לוורד (ושיפר את ביצועים שלי בעשרות מונים)

Sub ARRAYSAMPLE2()
Dim otext As String
Dim wordList() As String
Dim temporal As String
Dim newdoc As Document
Dim confirmation As VbMsgBoxResult

    
    confirmation = MsgBox("אל תשתמשו בסמך גדול, כי יקח לזה הרבה זמן, רצונך למהשיך", _
                    vbYesNo + vbQuestion)

If confirmation = vbYes Then
    
    otext = ActiveDocument.Content
    wordList = Split(otext, " ")
    
    
    'sort with Bubble Sort method
        For i = LBound(wordList) To (UBound(wordList) - 1)
            For j = i + 1 To UBound(wordList)
                If wordList(i) > wordList(j) Then
                    temporal = wordList(i)
                    wordList(i) = wordList(j)
                    wordList(j) = temporal
                End If
                DoEvents
            Next j
        Next i
    
    
    Set newdoc = Documents.Add
    newdoc.Content.InsertAfter Join(wordList, ", ")

End If
End Sub

[צדיק וטוב לו 0]

@menajemmendel חייב לציין שהמון מלל, אך לא הבנתי מה בדיוק המאקרו אמור לעשות.
זה נראה שביקשת מGPT לכתוב את הפוסט, וחבל.

[חוות דעת]

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

@menajemmendel חייב לציין שהמון מלל, אך לא הבנתי מה בדיוק המאקרו אמור לעשות.
זה נראה שביקשת מGPT לכתוב את הפוסט, וחבל.

גם אני לא הבנתי כלום.
לא יודע מה הבעיה, ועל מה הפתרון.

[דאנציג]

@menajemmendel

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

זה נראה שביקשת מGPT לכתוב את הפוסט,

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

Spoiler

@menajemmendel תכתוב למודל שאתה משתמש בו שייצר לך את הטקסטים, שהוא משעשע במקום להיות רציני.
מההיכרות שלי איתך, אלמלא השורה הזו:

אגב אני רוצה להדגיש שכמה שהמאקרוים שלי נראים יפים להפליא הם פרי יצירתי ולא ממו''ר GPT, פשוט לאחרונה רכשתי קורס של VBA לוורד (ושיפר את ביצועים שלי בעשרות מונים)

הייתי כותב לך שלא מתאים לך להעלות דברים של GPT...

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

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

[ששמעון]

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

[menajemmendel]

@ששמעון @דאנציג
או חבר'ה, תקשיבו,
אני באמת לא יודע מה עובר עליכם בזמן האחרון שאתם כ''כ קשוחים... אולי זה קשור למח' בין השו"ע והרש"ל אם ימי חנוכה נקבעו רק להלל והודאה או גם לשמחה (ואכמ''ל). אבל ברשותכם, אני רוצה לעשות סדר ולהבהיר:
בואו נגיד את האמת – שני המאקרואים שהעליתי פה הם לא שימושיים בכלל.
אני יודע את זה, ואתם יודעים את זה (לפחות עכשיו). אבל רגע, לפני שאתם זורקים את הקוד לפח ואותי ביחד עם הקוד, אבהיר שיש כאן הרבה מה ללמוד משתי הקודים האלו: המאקרו הראשון – ספירת אותיות:
הרעיון פה הוא לא אם זה באמת נחוץ לספור כמה פעמים האות "ק" מופיעה בטקסט.
הרעיון הוא ללמוד איך לעבוד עם Arrays – איך יוצרים רשימה, איך משתמשים בה, איך יודעים מה ההתחלה ומה הסוף (LBound ו-UBound). כמו שאכן ידידנו @u88 למד את זה והבין את הנושא בצורה ברורה!
מאקרו השני – סידור לפי א"ב:
כן, @ששמעון צודק שאפשר היה לעשות את זה בקלות עם מיון בסיסי: להחליף רווחים באנטרים, למיין ואז להחזיר. והאמת שהשיטה שהוא מציע עדיפה כשמדובר במסמכים גדולים, כי היא הרבה יותר מהירה (המאקרו שלי יקח לו הרבה זמן), אבל התועלת גדולה של המאקרו שלי הוא: כך:
מה תעשו אם תצטרכו למיין דברים בתוך המאקרו [לקבוע משתנים וכדו'] עצמו לצורך המשך שימשו במאקרו, [ולא דוקא לפי סדר אלפאבתי, אלא לפי כל ערך אחר כגון לסדר תמונות לפי הגודל שלהם, או משהו כזה]? שם אין לכם את כלי המיון של וורד, ואתם חייבים אלגוריתם כמו Bubble Sort. [אגב לפני שבועים היה לי כזה מקרה, ואני לא ידעתי על קיומו של אלגוריטם בועה, וחשבתי על הרבה זמן, איך ניתן לסדר, ובאמת יצא לי משהו מאד דומה לאגוריטם בועה, ואתמול גיליתי את השיטה של בועה, ושאני לא הגאון הראשון.]
בקיצור:
אני לא באמת חושב שהמאקרואים האלה יגרמו לכם לפרוץ בקריאות התפעלות, אבל הם כן תרגיל טוב למי שרוצה ללמוד VBA, ועשיתי את זה עם קצר הומור,
ואם זה לא מעניין אתכם – אז פשוט תעברו הלאה.

ו @דאנציג לגבי מה שכתבת

מההיכרות שלי איתך, אלמלא השורה הזו:
אגב אני רוצה להדגיש שכמה שהמאקרוים שלי נראים יפים להפליא הם פרי יצירתי ולא ממו''ר GPT, פשוט לאחרונה רכשתי קורס של VBA לוורד (ושיפר את ביצועים שלי בעשרות מונים)

הייתי כותב לך שלא מתאים לך להעלות דברים של GPT...

לא הבנתי כוונתך באמת הקודים לא GPT כתב אותם, והקישור שהבאתי לכם על קורס VBA הוא אמיתי, באמת קורס מוצלח למי שזה מעניין אותו (אבל הוא באנגלית, ולא מסביר ממש למתחילים) יש להדגיש שזה הקורס היחיד שמצאתי על VBA לוורד, כולם מלמדים על אקסל ומתרגמים לוורד (אף אני כשהתחלתי עם VBA עשיתי כך בלית ברירה)

[pcinfogmach]

פוסט זה נמחק!

[pcinfogmach]

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

מה תעשו אם תצטרכו למיין דברים בתוך המאקרו [לקבוע משתנים וכדו'] עצמו לצורך המשך שימשו במאקרו, [ולא דוקא לפי סדר אלפאבתי, אלא לפי כל ערך אחר כגון לסדר תמונות לפי הגודל שלהם, או משהו כזה]? שם אין לכם את כלי המיון של וורד, ואתם חייבים אלגוריתם כמו Bubble Sort. [אגב לפני שבועים היה לי כזה מקרה, ואני לא ידעתי על קיומו של אלגוריטם בועה, וחשבתי על הרבה זמן, איך ניתן לסדר, ובאמת יצא לי משהו מאד דומה לאגוריטם בועה, ואתמול גיליתי את השיטה של בועה, ושאני לא הגאון הראשון.]

עיין כאן נראה שיש להם רעיון משופר
https://stackoverflow.com/a/38298771/23343154

שווה גם לחקור את CreateObject יייתכן שאפשר לייבא משהו עם פונקצונליות מובנית

Spoiler

וחשבתי על הרבה זמן, איך ניתן לסדר, ובאמת יצא לי משהו מאד דומה לאגוריטם בועה

עצה טובה לכל אלה שאוהבים לחשוב ולהמציא באמת שכדאי לכם לעשות חיפוש באינטרנט לפני שאתם ממציאים את הגלגל - וגם לפעמים לפני שאתם שואלים את GPT

[menajemmendel]

@pcinfogmach באמת יש הרבה רעיונות יותר טובים יש גם INSERTION SORT וגם QUICKSORT, ובועה היא השיטה הכי פחות יעילה מכולם, והכי איטית, אבל היא גם הכי פשוטה, אז תלוי למה צריך את זה. בכל אופן לא התכוונתי שזה הצורה האופטימלית, אלא שלמטרות למידה זה טוב.

[מניין]

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

Sub גודל_עמודים_ושוליים_בכל_המסמך()
    Dim sec As section
    Dim pageSetup As pageSetup
    Dim currentWidth As Double
    Dim currentHeight As Double
    Dim marginTop As Double
    Dim marginBottom As Double
    Dim marginLeft As Double
    Dim marginRight As Double
    Dim startPage As Long
    Dim endPage As Long
    Dim msg As String
    Dim totalPages As Long
    Dim currentSectionIndex As Long
    Dim lastWidth As Double
    Dim lastHeight As Double
    Dim lastTopMargin As Double
    Dim lastBottomMargin As Double
    Dim lastLeftMargin As Double
    Dim lastRightMargin As Double
    Dim allPagesUniform As Boolean
    Dim firstRun As Boolean

    ' הודעת כותרת
    msg = "מידע על גדלי העמודים והשוליים במסמך (בסנטימטרים):" & vbCrLf
    totalPages = ActiveDocument.ComputeStatistics(wdStatisticPages)
    currentSectionIndex = 1
    startPage = 1
    firstRun = True
    allPagesUniform = True ' נניח בהתחלה שכולם אחידים

    ' לולאה לבדוק אם כל העמודים אחידים בגודל ובשוליים
    Do While startPage <= totalPages
        If currentSectionIndex > ActiveDocument.Sections.Count Then Exit Do
        Set sec = ActiveDocument.Sections(currentSectionIndex)
        Set pageSetup = sec.pageSetup
        currentWidth = pageSetup.PageWidth / 28.35 ' המרת רוחב לס"מ
        currentHeight = pageSetup.PageHeight / 28.35 ' המרת גובה לס"מ
        marginTop = pageSetup.TopMargin / 28.35 ' המרת שוליים עליונים לס"מ
        marginBottom = pageSetup.BottomMargin / 28.35 ' המרת שוליים תחתונים לס"מ
        marginLeft = pageSetup.LeftMargin / 28.35 ' המרת שוליים שמאליים לס"מ
        marginRight = pageSetup.RightMargin / 28.35 ' המרת שוליים ימניים לס"מ

        ' אם זו הפעם הראשונה, נגדיר את הערכים הראשונים
        If firstRun Then
            lastWidth = currentWidth
            lastHeight = currentHeight
            lastTopMargin = marginTop
            lastBottomMargin = marginBottom
            lastLeftMargin = marginLeft
            lastRightMargin = marginRight
            firstRun = False
        End If

        ' אם יש שינוי בגודל או בשוליים, העמודים לא אחידים
        If currentWidth <> lastWidth Or currentHeight <> lastHeight Or _
           marginTop <> lastTopMargin Or marginBottom <> lastBottomMargin Or _
           marginLeft <> lastLeftMargin Or marginRight <> lastRightMargin Then
            allPagesUniform = False
            Exit Do ' אין צורך לבדוק יותר אם העמודים לא אחידים
        End If

        ' מעבר לעמוד הבא
        startPage = startPage + 1
        If startPage > ActiveDocument.Sections(currentSectionIndex).Range.Information(wdActiveEndPageNumber) Then
            currentSectionIndex = currentSectionIndex + 1
            If currentSectionIndex > ActiveDocument.Sections.Count Then Exit Do
        End If
    Loop

    ' אם כל העמודים אחידים, הצגת הודעה אחת
    If allPagesUniform Then
        MsgBox "כל העמודים במסמך הם בגודל ושוליים זהים.", vbInformation, "מידע על גדלי עמודים ושוליים"
    Else
        ' אם יש עמודים שונים, מציגים את כל הנתונים
        DisplayPageDetails
    End If
End Sub

Sub DisplayPageDetails()
    Dim sec As section
    Dim pageSetup As pageSetup
    Dim currentWidth As Double
    Dim currentHeight As Double
    Dim marginTop As Double
    Dim marginBottom As Double
    Dim marginLeft As Double
    Dim marginRight As Double
    Dim startPage As Long
    Dim endPage As Long
    Dim msg As String
    Dim totalPages As Long
    Dim currentSectionIndex As Long

    ' הודעת כותרת
    msg = "מידע על גדלי העמודים והשוליים במסמך (בסנטימטרים):" & vbCrLf
    totalPages = ActiveDocument.ComputeStatistics(wdStatisticPages)
    currentSectionIndex = 1
    startPage = 1

    ' לולאה לבדיקת כל העמודים
    Do While startPage <= totalPages
        ' קבלת הגדרות הסעיף הנוכחי
        If currentSectionIndex > ActiveDocument.Sections.Count Then Exit Do
        Set sec = ActiveDocument.Sections(currentSectionIndex)
        Set pageSetup = sec.pageSetup
        currentWidth = pageSetup.PageWidth / 28.35 ' המרת רוחב לס"מ
        currentHeight = pageSetup.PageHeight / 28.35 ' המרת גובה לס"מ
        marginTop = pageSetup.TopMargin / 28.35 ' המרת שוליים עליונים לס"מ
        marginBottom = pageSetup.BottomMargin / 28.35 ' המרת שוליים תחתונים לס"מ
        marginLeft = pageSetup.LeftMargin / 28.35 ' המרת שוליים שמאליים לס"מ
        marginRight = pageSetup.RightMargin / 28.35 ' המרת שוליים ימניים לס"מ

        ' מציאת טווח עמודים עם אותו גודל ושוליים
        endPage = startPage
        Do While endPage <= totalPages
            If ActiveDocument.Sections(currentSectionIndex).pageSetup.PageWidth <> pageSetup.PageWidth Or _
               ActiveDocument.Sections(currentSectionIndex).pageSetup.PageHeight <> pageSetup.PageHeight Or _
               ActiveDocument.Sections(currentSectionIndex).pageSetup.TopMargin <> pageSetup.TopMargin Or _
               ActiveDocument.Sections(currentSectionIndex).pageSetup.BottomMargin <> pageSetup.BottomMargin Or _
               ActiveDocument.Sections(currentSectionIndex).pageSetup.LeftMargin <> pageSetup.LeftMargin Or _
               ActiveDocument.Sections(currentSectionIndex).pageSetup.RightMargin <> pageSetup.RightMargin Then
                Exit Do
            End If
            endPage = endPage + 1
            If endPage > ActiveDocument.Sections(currentSectionIndex).Range.Information(wdActiveEndPageNumber) Then
                currentSectionIndex = currentSectionIndex + 1
                If currentSectionIndex > ActiveDocument.Sections.Count Then Exit Do
            End If
        Loop
        endPage = endPage - 1

        ' הוספת טווח עמודים עם גודל ושוליים להודעה
        If startPage <= endPage Then
            msg = msg & "עמודים " & startPage & " עד " & endPage & ":" & vbCrLf
            msg = msg & "  גודל העמוד: " & vbCrLf
            msg = msg & Format(currentWidth, "0.00") & " x " & Format(currentHeight, "0.00") & " ס''מ" & vbCrLf
            msg = msg & "  שוליים:" & vbCrLf
            msg = msg & "    עליון: " & Format(marginTop, "0.00") & " ס''מ" & vbCrLf
            msg = msg & "    תחתון: " & Format(marginBottom, "0.00") & " ס''מ" & vbCrLf
            msg = msg & "    שמאלי: " & Format(marginLeft, "0.00") & " ס''מ" & vbCrLf
            msg = msg & "    ימני: " & Format(marginRight, "0.00") & " ס''מ" & vbCrLf
        End If

        ' מעבר לטווח הבא
        startPage = endPage + 1
    Loop

    ' הצגת ההודעה בעברית
    MsgBox msg, vbInformation, "מידע על גדלי עמודים ושוליים"
End Sub

[שלמה11]

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

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

אולי כדאי לצבוע את המילה הראשונה/האחרונה לא בצבע אדום/ירוק רגיל אלא:
Font.Color = RGB(255, 1, 1)
Font.Color = RGB(1, 255, 1)
ואז יהיה אפשר לעשות מאקרו של הסרה, מבלי לפגוע בטקסטים אחרים שצבועים באדום/ירוק

[מניין]

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

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

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

אולי כדאי לצבוע את המילה הראשונה/האחרונה לא בצבע אדום/ירוק רגיל אלא:
Font.Color = RGB(255, 1, 1)
Font.Color = RGB(1, 255, 1)
ואז יהיה אפשר לעשות מאקרו של הסרה, מבלי לפגוע בטקסטים אחרים שצבועים באדום/ירוק

עודכן כאן בתוספת מאקרו להסרה

[menajemmendel]

@מניין אני רואה שבכמה מאקרו אתה מוסיף את האפשרות של ביטול פעולה אחרונה, וזה מאד עוזר, אבל חשוב מאד, לדעת שאם אתה מוסיף את זה אז עוד יותר חשוב להוסיף גם error handeling, כמו שהסברתי כאן (אחרת עלול לגרום לבעיות שאחריתם מי ישורנו)

[מניין]

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

@מניין אני רואה שבכמה מאקרו אתה מוסיף את האפשרות של ביטול פעולה אחרונה, וזה מאד עוזר, אבל חשוב מאד, לדעת שאם אתה מוסיף את זה אז עוד יותר חשוב להוסיף גם error handeling, כמו שהסברתי כאן (אחרת עלול לגרום לבעיות שאחריתם מי ישורנו)

עודכן כאן וגם כאן

[יאיר דניאל]

@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/