האם אפשר להגדיר בוורד שיהיה עיטור ליד כל כותרת?

[יאיר הבהיר]

@לשכת-הרב המייל שלי נמצא בפרופיל, נראה לי עדיף להמשיך שם... [בהמשך הערב]

[שלמה11]

פוסט זה נמחק!

[לשכת הרב]

@שלמה11 זה לא נותן לי להעתיק את העיטור עצמו לתוך תיבת ההחלפה.
זה העיטור לדוגמא: [זה עיטור ממש ולא גופן של עיטור]

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

[שלמה11]

@לשכת-הרב אני התכוונתי לתו שמופיע בתוך הגופן (ולא לתמונה)
אבל יש דרך פשוטה יותר.
תלחץ לחיצה ימנית על הסגנון כותרת1 (או הכותרת שאותה תרצה לשנות)>שינוי>עיצוב>מספור>תבליטים>הגדר תבליט חדש>תבחר את התמונה שלך מהמחשב, אישור וכו'
זה יכניס את העיצוב לכל תחילת כותרת, (אבל לא לסוף)

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

Sub הוספת_עיטור ()
    Dim dlg As FileDialog
    Dim imgPath As String
    Dim para As Paragraph
    Dim rngStart As Range, rngEnd As Range
    Dim StyleName As String
    
    On Error GoTo Ending
    Application.UndoRecord.StartCustomRecord
    ' ôúéçú ãéàìåâ ìáçéøú ÷åáõ
    Set dlg = Application.FileDialog(msoFileDialogFilePicker)
    With dlg
        .Title = "áçø úîåðä ìäåñôä áúçéìú åñåó äëåúøú"
        .Filters.Clear
        .Filters.Add "תמונות", "*.jpg; *.jpeg; *.png; *.bmp; *.gif"
        If .Show <> -1 Then GoTo Ending ' àí äîùúîù áéèì
        imgPath = .SelectedItems(1)
    End With
    StyleName = InputBox("הכנס את שם הכותרת (בצורה מדויקת!)")
    ' îòáø òì ëì äôñ÷àåú áîñîê
    For Each para In ActiveDocument.Paragraphs
        If para.Style = StyleName Then
            ' úçéìú äôñ÷ä
            Set rngStart = para.Range.Duplicate
            rngStart.Collapse Direction:=wdCollapseStart
            rngStart.InlineShapes.AddPicture FileName:=imgPath, LinkToFile:=False, SaveWithDocument:=True

            ' ñåó äôñ÷ä
            Set rngEnd = para.Range.Duplicate
            rngEnd.Collapse Direction:=wdCollapseEnd
            rngEnd.Move wdCharacter, -1
            rngEnd.InsertAfter " " ' øååç ìôðé äúîåðä
            rngEnd.Collapse Direction:=wdCollapseEnd
            rngEnd.InlineShapes.AddPicture FileName:=imgPath, LinkToFile:=False, SaveWithDocument:=True
        End If
    Next para

    MsgBox "הכנסת העיטור בוצעה בהצלחה", vbInformation
Ending:
    Application.UndoRecord.EndCustomRecord
End Sub

להפעלת הקוד פותחים את בלשונית תצוגה>פקודות מאקרו>הצג פקודות מאקרו>צור>מדביקים>ולוחצים במקלדת על FN+F5 (זה מריץ את הקוד)

[מניין]

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

Sub הוספת_עיטור()
    Dim dlg As FileDialog
    Dim imgPathBefore As String
    Dim imgPathAfter As String
    Dim useSameImage As Boolean
    Dim para As Paragraph
    Dim rngStart As Range, rngEnd As Range
    Dim StyleName As String

    On Error GoTo Ending
    Application.UndoRecord.StartCustomRecord

    ' בחירת עיטור לפני הפסקה
    Set dlg = Application.FileDialog(msoFileDialogFilePicker)
    With dlg
        .Title = "בחר תמונה לעיטור לפני הפסקה"
        .Filters.Clear
        .Filters.Add "תמונות", "*.jpg; *.jpeg; *.png; *.bmp; *.gif"
        If .Show <> -1 Then GoTo Ending
        imgPathBefore = .SelectedItems(1)
    End With

    ' שאל אם רוצים עיטור שונה אחרי
    If MsgBox("האם אתה רוצה לבחור עיטור שונה לאחר הפסקה?", vbYesNo + vbQuestion, "בחירת עיטור לאחר") = vbYes Then
        Set dlg = Application.FileDialog(msoFileDialogFilePicker)
        With dlg
            .Title = "בחר תמונה לעיטור אחרי הפסקה"
            .Filters.Clear
            .Filters.Add "תמונות", "*.jpg; *.jpeg; *.png; *.bmp; *.gif"
            If .Show <> -1 Then GoTo Ending
            imgPathAfter = .SelectedItems(1)
        End With
    Else
        imgPathAfter = imgPathBefore ' משתמש באותו עיטור לשני הצדדים
    End If

    StyleName = InputBox("הכנס את שם הכותרת (בצורה מדויקת!)")

    ' מעבר על כל הפסקאות והוספת העיטורים
    For Each para In ActiveDocument.Paragraphs
        If para.Style = StyleName Then
            ' עיטור לפני
            Set rngStart = para.Range.Duplicate
            rngStart.Collapse Direction:=wdCollapseStart
            rngStart.InlineShapes.AddPicture FileName:=imgPathBefore, LinkToFile:=False, SaveWithDocument:=True

            ' עיטור אחרי
            Set rngEnd = para.Range.Duplicate
            rngEnd.Collapse Direction:=wdCollapseEnd
            rngEnd.Move wdCharacter, -1
            rngEnd.InsertAfter " "
            rngEnd.Collapse Direction:=wdCollapseEnd
            rngEnd.InlineShapes.AddPicture FileName:=imgPathAfter, LinkToFile:=False, SaveWithDocument:=True
        End If
    Next para

    MsgBox "הכנסת העיטורים בוצעה בהצלחה", vbInformation

Ending:
    Application.UndoRecord.EndCustomRecord
End Sub

[שלמה11]

@מניין כתב בהאם אפשר להגדיר בוורד שיהיה עיטור ליד כל כותרת?:

שהעיטור

רגע... אני באמצע להכין משהו טוב...

[u88]

@שלמה11 תודה זה יעזור לכולנו

[מניין]

@שלמה11 מיוחד, תוכל להוסיף גם כמה רווח רוצים בין העיטור לטקסט.

[לשכת הרב]

יש אופציה להגדיר עיטור מצד ימין של הכותרת ומצד שמאל, בלי פקודות מאקרו [שהנושא של מאקרו די חדש לי...]?

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

[שלמה11]

@לשכת-הרב הגיע הזמן להפסיק להסתבך...
יצרתי בס"ד מאקרו מסודר ניתן להוריד מפה
(עכשיו לא צריך להעתיק ולהדביק וכו' רק פותחים את הקובץ המצורף + הקובץ שרוצים לערוך, ובקובץ שרוצים לערוך המאקרו יופיע בחלונית תצוגה>פקודות מאקרו>פקודות נוספות>הוספת עיטור לכותרת)

Spoiler

ניתן גם להוסיף את הקובץ לנתיב הבא:

%AppData%\Microsoft\Word\STARTUP

זה יאפשר להפעיל את הפקודה גם בלי לפתוח את הקובץ בכל פעם