מאקרו להזרחה

[מהדיר ספרים - ארכיון]

תאריך ההודעה המקורית: 28/05/2024 02:22

שיתפתי כאן בעבר מאקרו להזרחה.
הוא עושה כמה פעולות:

1. מחפש את ההזרחה הבאה
2. אם יש קטע מסומן, הוא מזריח אותו
3. אם הקטע מוזרח, הוא מבטל את ההזרחה.
   לחיצה נוספת תחפש את ההזרחה הבאה [פונקציה 1]
   ושוב ניתן לבטל את הבא. [פונקציה 3]

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

הדבר הזה יעיל מאד למי שרגיל להשתמש בהזרחות לסימון קטעים שצריכם בדיקה, ואח"כ
עובר ומחפש את הקטעים האלו כדי לטפל.
הנה המאקרו [לעצמי עשיתי לו קצ"ד של ALT+ב, הם צמודים אחד לשני והאות ב הוא
באנלית COLOR דהיינו צבע]

Sub הדגשצהוב()

' Check if text is selected
If Selection.Type = wdSelectionIP Then
    ' No text selected, search and select next highlighted text
    Dim rng As Range
    Set rng = ActiveDocument.Range

    ' Set the starting point to the current selection
    rng.Start = Selection.End

    ' Find the next highlighted text in the main document
    With rng.Find
        .ClearFormatting
        .Highlight = True
        .Wrap = wdFindStop
        .Execute
    End With

    If rng.Find.Found Then
        rng.Select
    Else
        ' If not found in main document, check in footnotes
        Dim ftNote As Footnote
        Dim ftRng As Range
        Dim foundInFootnote As Boolean
        foundInFootnote = False

        For Each ftNote In ActiveDocument.Footnotes
            Set ftRng = ftNote.Range
            With ftRng.Find
                .ClearFormatting
                .Highlight = True
                .Wrap = wdFindStop
                .Execute
            End With

            If ftRng.Find.Found Then
                ftRng.Select
                foundInFootnote = True
                Exit For
            End If
        Next ftNote

        If Not foundInFootnote Then
            MsgBox "אין עוד טקסט מסומן עד סוף המסמך, כולל הערות שוליים."
        End If
    End If
Else
    ' Check if the selected range is already highlighted
    If Selection.Range.HighlightColorIndex = wdYellow Then
        ' If highlighted, remove the highlighting
        Selection.Range.HighlightColorIndex = wdNoHighlight
            Selection.MoveRight Unit:=wdCharacter, Count:=1
              Else
        ' If not highlighted, apply yellow highlighting
        Options.DefaultHighlightColorIndex = wdYellow
        Selection.Range.HighlightColorIndex = wdYellow
    End If
End If

End Sub

[יהושע ו - ארכיון]

תאריך ההודעה המקורית: 28/05/2024 02:39

כל הכבוד!

איך אני מחליף אותו עם המאקרו הקודם שיש לי כבר? (היה לי שימושי ביותר, ואכן
מאוד הפריע לי שלא עבר בהערות שוליים).

ייש"כ

מאת: [email protected]

[מהדיר ספרים - ארכיון]

תאריך ההודעה המקורית: 28/05/2024 02:54

אכתוב כאן איך שותלים את המאקרו בוורד, וכן איך מחליפים

להעתיק את המאקרו ששלחתי ללוח הגזירים CTRL+C
תצוגה>פקודות מאקרו>הצג פקודות מאקרו>

אם יש לך כבר את המאקרו הזה, לבחור [לכתוב בחלונית] הדגש_צהוב

לבחור אותו ואז להקיש על הכפתור "צעד לתוך"

המקרו הזה יופיע. לבחור את כל המאקרו [עד המילים END SUB. המילים האלו מופיעים
אחרי כל מאקרו שברשימה. אז יש לעבור על השורות בזהירות ולוודא שבוחרים רק את
המאקרו הזה ולא נבחרו בטעות עוד קבוצה של שורות]

למחוק אותו ע"י מקשה המחיקה DELETE

אם עדיין אין את המאקרו בגירסה הקודמת שלו,

לבחור כפתור "צור"

נפתח חלון עם כל המאקרואים.

לגלול לתחתית

להדביק את המאקרו החדש. CTRL+V

לסגור את החלון. אין צורך ללחוץ על שמירה לפני הסגירה

--

[יהושע ו - ארכיון]

תאריך ההודעה המקורית: 28/05/2024 02:57

התגובה של יהושע ו בוצעה דרך Gmail
https://www.google.com/gmail/about/?utm_source=gmail-in-product&utm_medium=et&utm_campaign=emojireactionemail#app

מאת: [email protected]

קבצים מצורפים:

• file-0

[a f - ארכיון]

תאריך ההודעה המקורית: 28/05/2024 04:20

יש"כ מאוד עזר לי

 

 

 

From: יהושע ו [[email protected]]
Sent: Monday, May 27, 2024 7:57 PM
To: מהדיר ספרים [[email protected]]
Cc: עריכה תורנית [[email protected]]
Subject: Re: [הבית לעורך התורני] מאקרו להזרחה

 

התגובה של יהושע ו בוצעה דרך Gmail
[https://www.google.com/gmail/about/?utm_source=gmail-in-product&utm_medium=et&utm_campaign=emojireactionemail#app]

 

[[email protected]]>: