עזרה | מאקרו שעזרו לי הרבה הריני משתף

[בלוק]

מאקרו להוריד כל מסגרות הטקסט
Sub RemoveAllFramesKeepText()

Dim i As Long

Application.ScreenUpdating = False

For i = ActiveDocument.Frames.Count To 1 Step -1
    ActiveDocument.Frames(i).Delete
Next i

Application.ScreenUpdating = True

MsgBox "Done"

End Sub

מאקרו להוריד מירכוז כל המסמך
Sub RemoveSpecialLastLineCentering()

Dim p As Paragraph
Dim r As Range
Dim s As String
Dim pos As Long

Application.ScreenUpdating = False

For Each p In ActiveDocument.Paragraphs

    s = p.Range.Text
    pos = InStrRev(s, Chr(11))

    If pos > 0 Then

        Set r = p.Range.Duplicate

        ' מיד אחרי Shift+Enter
        r.Start = p.Range.Start + pos
        r.End = r.Start + 1

        ' מוחק את התו המיוחד שבתחילת השורה האחרונה
        If r.End <= p.Range.End Then
            r.Delete
        End If

        ' מחליף Shift+Enter ברווח רגיל
        Set r = p.Range.Duplicate
        r.Start = p.Range.Start + pos - 1
        r.End = r.Start + 1
        r.Text = " "

    End If

Next p

Application.ScreenUpdating = True

MsgBox "Done"

End Sub

מאקרו מדגיש תיבה ראשונה בפיסקה
Sub BoldFirstWordHebrew()

Dim p As Paragraph
Dim r As Range
Dim firstWord As Range
Dim startPos As Long
Dim endPos As Long
Dim ch As String
Dim changedCount As Long

Application.ScreenUpdating = False

For Each p In ActiveDocument.Paragraphs

    Set r = p.Range.Duplicate

    ' Exclude the paragraph mark
    If r.End > r.Start Then
        r.End = r.End - 1
    End If

    If r.End <= r.Start Then GoTo NextParagraph

    ' Skip centered headings
    If r.ParagraphFormat.Alignment = _
       wdAlignParagraphCenter Then
        GoTo NextParagraph
    End If

    ' Skip spaces and tabs at paragraph start
    Do While r.Start < r.End

        ch = ActiveDocument.Range( _
             r.Start, r.Start + 1).Text

        If ch = " " Or _
           ch = vbTab Or _
           ch = Chr(160) Then

            r.MoveStart wdCharacter, 1

        Else
            Exit Do
        End If

    Loop

    If r.Start >= r.End Then GoTo NextParagraph

    startPos = r.Start
    endPos = startPos

    ' Find the end of the first word
    Do While endPos < r.End

        ch = ActiveDocument.Range( _
             endPos, endPos + 1).Text

        If ch = " " Or _
           ch = vbTab Or _
           ch = Chr(11) Or _
           ch = Chr(13) Or _
           ch = Chr(160) Then

            Exit Do
        End If

        endPos = endPos + 1

    Loop

    If endPos > startPos Then

        Set firstWord = ActiveDocument.Range( _
                        startPos, endPos)

        ' Apply both regular and Hebrew bold
        firstWord.Font.Bold = True
        firstWord.Font.BoldBi = True

        changedCount = changedCount + 1

    End If

NextParagraph:
Next p

Application.ScreenUpdating = True

MsgBox "Done. First words bolded: " & _
       changedCount

End Sub
מאקרו שהופך הפניה ע"י מספור להפניה ע"י כוכבית
Sub Footnotes_To_Asterisk_Safe()

Dim doc As Document
Dim i As Long
Dim fn As Footnote
Dim newFn As Footnote

Dim anchorPos As Long

Dim src As Range
Dim dst As Range

Dim tempDoc As Document
Dim tempRng As Range

Set doc = ActiveDocument

If doc.Footnotes.Count = 0 Then
    MsgBox "אין הערות שוליים במסמך.", vbInformation
    Exit Sub
End If

If MsgBox( _
    "נמצאו " & doc.Footnotes.Count & " הערות שוליים." & vbCrLf & vbCrLf & _
    "המאקרו יהפוך את כל סימני ההפניה לכוכבית *" & vbCrLf & _
    "גם בגוף המסמך וגם בהערות למטה." & vbCrLf & vbCrLf & _
    "מומלץ מאוד לשמור עותק גיבוי לפני ההמשך." & vbCrLf & vbCrLf & _
    "להמשיך?", _
    vbYesNo + vbQuestion, _
    "המרת סימני הערות שוליים") <> vbYes Then Exit Sub

Application.ScreenUpdating = False

On Error GoTo ErrorHandler

Set tempDoc = Documents.Add

' עובדים מההערה האחרונה לראשונה
For i = doc.Footnotes.Count To 1 Step -1

    Set fn = doc.Footnotes(i)

    ' שמירת מקום סימן ההפניה בגוף הטקסט
    anchorPos = fn.Reference.Start

    ' שמירת כל תוכן ההערה עם העיצוב
    Set src = fn.Range.Duplicate

    ' מוציאים רק את סימן הפסקה הסופי של Word
    If src.End > src.Start Then
        If src.Characters.Last.Text = Chr(13) Then
            src.End = src.End - 1
        End If
    End If

    ' ניקוי המסמך הזמני
    tempDoc.Content.Delete

    Set tempRng = tempDoc.Range(0, 0)
    tempRng.FormattedText = src.FormattedText

    ' מחיקת ההערה הישנה
    fn.Delete

    ' יצירת הערה חדשה באותו מקום עם *
    Set newFn = doc.Footnotes.Add( _
        Range:=doc.Range(anchorPos, anchorPos), _
        Reference:="*" _
    )

    ' טווח תוכן ההערה החדשה
    Set dst = newFn.Range.Duplicate

    If dst.End > dst.Start Then
        If dst.Characters.Last.Text = Chr(13) Then
            dst.End = dst.End - 1
        End If
    End If

    ' החזרת התוכן והעיצוב
    Set tempRng = tempDoc.Content.Duplicate

    If tempRng.End > tempRng.Start Then
        If tempRng.Characters.Last.Text = Chr(13) Then
            tempRng.End = tempRng.End - 1
        End If
    End If

    dst.FormattedText = tempRng.FormattedText

Next i

tempDoc.Close SaveChanges:=wdDoNotSaveChanges

Application.ScreenUpdating = True

MsgBox _
    "הפעולה הסתיימה בהצלחה." & vbCrLf & _
    "כל " & doc.Footnotes.Count & _
    " ההערות מוצגות כעת בכוכבית *.", _
    vbInformation

Exit Sub

ErrorHandler:

Application.ScreenUpdating = True

On Error Resume Next
tempDoc.Close SaveChanges:=wdDoNotSaveChanges

MsgBox _
    "המאקרו נעצר בהערה מספר " & i & "." & vbCrLf & _
    "שגיאה " & Err.Number & ": " & Err.Description, _
    vbCritical

End Sub
מאקרו להצמיד הערות שוליים לתחילת הטור
Sub Remove_Space_After_Footnote_Star_Final()

Dim fn As Footnote
Dim p As Paragraph
Dim r As Range
Dim i As Long
Dim n As Long

Application.ScreenUpdating = False
On Error GoTo ErrHandler

For i = ActiveDocument.Footnotes.Count To 1 Step -1

    Set fn = ActiveDocument.Footnotes(i)
    Set p = fn.Range.Paragraphs(1)

    If p.Range.Characters.Count >= 2 Then

        ' בוחרים בדיוק את התו השני בפסקה
        Set r = p.Range.Characters(2).Duplicate

        If Len(r.Text) = 1 Then
            If AscW(r.Text) = 32 Then
                r.Delete
                n = n + 1
            End If
        End If

    End If

Next i

Application.ScreenUpdating = True

MsgBox "הסתיים." & vbCrLf & _
       "נמחק הרווח ב-" & n & " הערות שוליים.", _
       vbInformation

Exit Sub

ErrHandler:

Application.ScreenUpdating = True

MsgBox "נעצר בהערה מספר " & i & vbCrLf & _
       Err.Number & " - " & Err.Description, vbExclamation

End Sub
מאקרו שלא יהיה גרשיים ומקפים מסולסלים וכן משוה כל הקוים
Sub MakeQuotesAndDashesStraight()

Application.ScreenUpdating = False

ReplaceAllText ChrW(8220), Chr(34)   ' “
ReplaceAllText ChrW(8221), Chr(34)   ' ”

ReplaceAllText ChrW(8216), Chr(39)   ' ‘
ReplaceAllText ChrW(8217), Chr(39)   ' ’

ReplaceAllText ChrW(8211), "-"       ' –
ReplaceAllText ChrW(8212), "-"       ' —

Application.ScreenUpdating = True

MsgBox "בוצע בהצלחה", vbInformation

End Sub

Private Sub ReplaceAllText(ByVal FindText As String, ByVal ReplaceText As String)

Dim rng As Range
Set rng = ActiveDocument.Content

With rng.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = FindText
    .Replacement.Text = ReplaceText
    .Forward = True
    .Wrap = wdFindContinue
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .Execute Replace:=wdReplaceAll
End With

End Sub

[שמעון פרידנן]

@בלוק כתב:

מאקרו שהופך הפניה ע"י מספור להפניה ע"י כוכבית

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

[בלוק]

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

בוורד אפשר להוסיף הערת שוליים עם סימן מותאם אישית: הפניות → החץ הקטן של "הערות שוליים" → סימן מותאם אישית (Custom mark), ושם להקליד *.

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

כלומר:

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

[שמעון פרידנן]

@בלוק כתב:

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

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

[בלוק]

כשאתה בוחר * ב־סימן מותאם אישית, וורד בדרך כלל משתמש בזה בשביל ההערה שאתה מוסיף כעת; הוא לא בהכרח עובר אחורה ומשכתב את כל סימוני ההערות שכבר קיימים במסמך.

[שמעון פרידנן]

@בלוק כתב:

כשאתה בוחר * ב־סימן מותאם אישית, וורד בדרך כלל משתמש בזה בשביל ההערה שאתה מוסיף כעת; הוא לא בהכרח עובר אחורה ומשכתב את כל סימוני ההערות שכבר קיימים במסמך.

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