מאקרו שיצרתי לבקשתו של אחד מחברי הפורום - להחלפת גופנים ע"י מאקרו.
גירסה א:
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
Spoiler
[image: 1777377433495-e0ac8a21-6100-4afe-83f5-dcf99c283027-image.png] [image: 1777377443133-0eda229e-2e5c-444c-af5e-5a499d7e7876-image.png]
גירסה ב:
בחירת גופן להחלפה - מתוך רשימה
Sub ReplaceSpecificFont()
Dim docFonts As New Collection
Dim targetFont As String
Dim replacementFont As String
Dim lastUsedFont As String
Dim i As Long
Dim fontChoice As String
Dim answer As VbMsgBoxResult
' 1. סריקת המסמך לזיהוי פונטים קיימים
On Error Resume Next
Dim para As Paragraph
For Each para In ActiveDocument.Paragraphs
' הוספת הגופן הרגיל והגופן העברי לאוסף
If para.Range.Font.Name <> "" Then docFonts.Add para.Range.Font.Name, para.Range.Font.Name
If para.Range.Font.NameBi <> "" Then docFonts.Add para.Range.Font.NameBi, para.Range.Font.NameBi
Next para
On Error GoTo 0
If docFonts.Count = 0 Then
MsgBox "לא נמצאו גופנים מזוהים.", vbExclamation
Exit Sub
End If
' 2. בחירת הגופן להחלפה
Dim fontList As String
fontList = "בחר מספר גופן להחלפה:" & vbCrLf
For i = 1 To docFonts.Count
fontList = fontList & i & ". " & docFonts(i) & vbCrLf
Next i
fontChoice = InputBox(fontList, "חפש והחלף גופן")
If Not IsNumeric(fontChoice) Then Exit Sub
i = CInt(fontChoice)
If i < 1 Or i > docFonts.Count Then Exit Sub
targetFont = docFonts(i)
' 3. בחירת גופן היעד
lastUsedFont = GetSetting("MyWordMacros", "Settings", "LastFont", "David")
answer = MsgBox("להחליף את " & targetFont & " ב-" & lastUsedFont & "?" & vbCrLf & _
"לחץ 'כן' לאישור, או 'לא' לבחירה מרשימה.", _
vbYesNoCancel + vbQuestion + vbMsgBoxRight + vbMsgBoxRtlReading)
If answer = vbYes Then
replacementFont = lastUsedFont
ElseIf answer = vbNo Then
With Application.Dialogs(wdDialogFormatFont)
If .Show = -1 Then
replacementFont = Selection.Font.NameBi
If replacementFont = "" Or replacementFont = "0" Then replacementFont = Selection.Font.Name
End If
End With
Else
Exit Sub
End If
If replacementFont = "" Or replacementFont = "0" Then Exit Sub
SaveSetting "MyWordMacros", "Settings", "LastFont", replacementFont
' 4. ביצוע ההחלפה (שיטה משופרת)
Application.ScreenUpdating = False
' פקודת ההחלפה צריכה לרוץ פעמיים כדי לכסות גם עברית וגם אנגלית בוודאות
Call ExecuteFontReplace(targetFont, replacementFont, True) ' עבור עברית
Call ExecuteFontReplace(targetFont, replacementFont, False) ' עבור אנגלית
Application.ScreenUpdating = True
Application.ScreenRefresh
MsgBox "הפעולה הושלמה עבור הגופן: " & targetFont, vbInformation
End Sub
' פונקציית עזר לביצוע ההחלפה בפועל' פונקציית עזר לביצוע ההחלפה בפועל - עם שמות פרמטרים תקינים
Sub ExecuteFontReplace(fTarget As String, fReplace As String, isBi As Boolean)
Dim r As Range
Set r = ActiveDocument.Content
r.Find.ClearFormatting
r.Find.Replacement.ClearFormatting
If isBi Then
r.Find.Font.NameBi = fTarget
r.Find.Replacement.Font.NameBi = fReplace
Else
r.Find.Font.Name = fTarget
r.Find.Replacement.Font.Name = fReplace
End If
' התיקון הקריטי: FindText במקום Text, ו-ReplaceWith במקום ReplacementText
r.Find.Execute FindText:="", ReplaceWith:="", _
Forward:=True, Wrap:=wdFindContinue, Format:=True, Replace:=wdReplaceAll
End Sub
זה עובד כך - תמונות בספויילר
Spoiler
[image: 1777561210359-4cdb8855-0815-4bbc-8af7-a663a92f2931-image.png]
[image: 1777561276175-3c7116dc-e525-4c44-bd9b-ba7833317db2-image.png]
[image: 1777561228591-53a647f1-eccc-4800-8591-c95458306e00-image.png]
גירסה ג:
(כמו גירסה ב' אבל לא צריך להקליד מספר גופן - אלא בוחרים בגופן עצמו - ההמשך אותו דבר).
פשוט להפעיל את הקובץ המצורף
החלפת גופנים.exe
או להכניס את הקובץ המצורף- לתיקיית הטמפלס של אופיס
(הקובץ למעלה - עושה את זה אוטומטית)
החלפת גופנים.dotm
Spoiler
[image: 1777563675549-c8abf13f-ba1c-4a68-8d02-38c8044bae4b-image.png]
 { const baseUrl = "https://www.google.co.il/search?q=site:mitmachim.top"; const m = location.pathname.match(/^\/(topic|category)\/(\d+)/); const type = m ? m[1] : null; const id = m ? m[2] : null; let searchInput; function search(path = "") { const query = searchInput.value.trim(); if (query) { window.open(`${baseUrl}${path}%20${encodeURIComponent(query)}`, "_blank"); } } let buttons = {}; buttons.searchAll = { id: "bb-search-all", label: `חיפוש ${type ? "בכל הפורום" : ""}`, className: type ? "btn-secondary" : "btn-primary", callback: () => search(), }; if (type === "topic") { buttons.searchTopic = { label: "חיפוש בנושא זה", className: "btn-primary", callback: () => search(`/topic/${id}`), }; } else if (type === "category") { buttons.searchCategory = { label: "חיפוש בקטגוריה זו", className: "btn-primary", callback: () => search(`/category/${id}`), }; } buttons.cancel = { label: "ביטול", className: "btn-default", "data-bs-dismiss": "modal" }; const dialog = bootbox.dialog({ title: '<div style="text-align:center;"><img src="/assets/uploads/files/1625950269825-mt-google.png" width="400" alt="חיפוש בגוגל"></div>', message: '<input id="bb-inp" class="bootbox-input bootbox-input-text form-control" placeholder="הקלידו כדי לחפש בגוגל" autocomplete="off"/>', buttons, backdrop: true, show: true, onEscape: true }); dialog.on("shown.bs.modal", function () { searchInput = document.getElementById("bb-inp"); if (searchInput) { searchInput.focus(); searchInput.addEventListener("keydown", function (e) { if (e.key === "Enter") { e.preventDefault(); const query = this.value.trim(); if (query) { search(); dialog.modal("hide"); } } else if (e.key === "Escape") { e.preventDefault(); dialog.modal("hide"); } }); } const searchAllButton = document.getElementById("bb-search-all"); if (searchAllButton) { searchAllButton.title = "לחצו על אנטר כדי לחפש"; } }); })(); void 0;){kind=link}