בקשה | יצירת מאקרו חיפוש והחלפה לפי עיצוב ולא מילים

עולה במסילה

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

יאיר דניאל

@עולה-במסילה
יצרתי לך - בעזרת AI.
מקווה שזה מה שהתכוונת...

תמונות בספויילר בסוף

Sub FinalFont_InstantUpdate()
    Dim selectedFont As String
    Dim lastUsedFont As String
    Dim answer As VbMsgBoxResult
    
    ' 1. בחירה מפורשת של הכל אם לא סומן כלום
    If Selection.Start = Selection.End Then
        ActiveDocument.Range.Select
    End If
    
    ' 2. שליפת הגופן האחרון
    lastUsedFont = GetSetting("MyWordMacros", "Settings", "LastFont", "David")
    
    ' 3. שאלה למשתמש
    answer = MsgBox("האם להשתמש בגופן האחרון: " & lastUsedFont & "?" & vbCrLf & _
                    "לחץ 'כן' לביצוע, או 'לא' לבחירה מרשימה.", _
                    vbYesNoCancel + vbQuestion + vbMsgBoxRight + vbMsgBoxRtlReading, "החלפת גופן")
    
    If answer = vbYes Then
        selectedFont = lastUsedFont
    ElseIf answer = vbNo Then
        With Application.Dialogs(wdDialogFormatFont)
            If .Show = -1 Then
                selectedFont = Selection.Font.NameBi
                If selectedFont = "" Or selectedFont = "0" Then selectedFont = Selection.Font.Name
            End If
        End With
        
        If selectedFont <> "" And selectedFont <> "0" Then
            SaveSetting "MyWordMacros", "Settings", "LastFont", selectedFont
        Else
            Selection.Collapse Direction:=wdCollapseStart
            Exit Sub
        End If
    Else
        Selection.Collapse Direction:=wdCollapseStart
        Exit Sub
    End If
    
    ' 4. ביצוע השינוי עם עדכון מסך כפוי
    If selectedFont <> "" Then
        Application.ScreenUpdating = False ' מכבה עדכון כדי להאיץ
        
        On Error Resume Next
        With Selection.Font
            .NameBi = selectedFont 
            .Name = selectedFont   
        End With
        On Error GoTo 0
        
        ' פקודות לרענון מיידי של המסך
        Application.ScreenUpdating = True ' מדליק חזרה ומאלץ רענון
        DoEvents ' משחרר את המערכת לעדכון גרפי
        Application.ScreenRefresh ' רענון סופי של Word
        
        Selection.Collapse Direction:=wdCollapseStart
        Application.StatusBar = "הגופן עודכן ל-" & selectedFont
    End If
End Sub

דאנציג

@עולה-במסילה כתב בבקשה | יצירת מאקרו חיפוש והחלפה לפי עיצוב ולא מילים:

שאני רוצה שיתחלף מה שעל כל קובץ לוקח זמן.

בתוסף 'עיצוב תורני' יש אפשרות החלפה במסמכים מרובים / לפי תיקיות!!!

יאיר דניאל

@דאנציג אבל הוא מאפשר החלפת קטעים מסויימים בתוך הקובץ, לא?

זאב לבן

@עולה-במסילה למה שלא תעבוד עם סגנונות?

דאנציג

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

@עולה-במסילה כתב בבקשה | יצירת מאקרו חיפוש והחלפה לפי עיצוב ולא מילים:

יש לי המון מסמכים שעיצבתי אותם פעם

ולעבור על מסמכים ישנים, ולבנות סגנונות וכו', זה הרבה יותר קשה מאשר חיפוש והחלפה או מאקרו.
אמנם אם הוא באמת רוצה, ניתן ליצור סגנונות, ולהעביר אותם למסמכים אחרים, (ואפשר גם חיצוני [בלי לפתוח קובץ קובץ], אבל רק על DOCX, ולא DOC)...