בקשת מידע | הקטנה של כמה גדלים בחצי מספר

[ישראל כהן]

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

[menajemmendel]

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

Sub SIZE_DECRACING()

Dim i As Single
Dim smallest_font As Single
Dim largest_font As Single
Dim SIZE_TO_DICRASE As Single

smallest_font = 10
largest_font = 20
SIZE_TO_DICRASE = 0.5

For i = smallest_font To largest_font Step 0.5
    With ActiveDocument.Range.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .TEXT = ""
        .Replacement.TEXT = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        .Font.SIZE = i
        .Font.SizeBi = i
        .Replacement.Font.SIZE = i - SIZE_TO_DICRASE
        .Replacement.Font.SizeBi = i - SIZE_TO_DICRASE
        .Execute Replace:=wdReplaceAll
    End With
Next i
MsgBox "גמר"
End Sub

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

[מניין]

@menajemmendel כתב בבקשת מידע | הקטנה של כמה גדלים בחצי מספר:

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

הנה מאקרו יותר פשוט שמגדיל או מקטין את כל הטקסט הנבחר בחצי נקודה.

 Sub הגדלה_בחצי_נקודה()
    Dim char As Range
    
    Application.ScreenUpdating = False
    On Error Resume Next ' מונע עצירה בשגיאה אם נבחר אובייקט ללא גודל גופן
    
    For Each char In Selection.Characters
        ' הגדלת גופן רגיל (אנגלית/מספרים)
        char.Font.Size = char.Font.Size + 0.5
        ' הגדלת גופן לשפות מימין לשמאל (עברית)
        char.Font.SizeBi = char.Font.SizeBi + 0.5
    Next char
    
    On Error GoTo 0
    Application.ScreenUpdating = True
End Sub
Sub הקטנה_בחצי_נקודה()
    Dim char As Range
    
    Application.ScreenUpdating = False
    On Error Resume Next
    
    For Each char In Selection.Characters
        ' בדיקה שגודל הגופן לא ירד מתחת למינימום המותר ב-Word (גודל 1)
        If char.Font.Size > 1 Then
            char.Font.Size = char.Font.Size - 0.5
        End If
        
        If char.Font.SizeBi > 1 Then
            char.Font.SizeBi = char.Font.SizeBi - 0.5
        End If
    Next char
    
    On Error GoTo 0
    Application.ScreenUpdating = True
End Sub

[menajemmendel]

@מניין זה לא יותר פשוט, המאקרו שלך הוא עובר בלולאה על כל האותיות של המסמך (אות אות), הוה אומר שבסמך ארוך יקח לו המון זמן, לכן אני עשיתי את זה דרך חפש החלף

[מניין]

@menajemmendel כתב בבקשת מידע | הקטנה של כמה גדלים בחצי מספר:

@מניין זה לא יותר פשוט, המאקרו שלך הוא עובר בלולאה על כל האותיות של המסמך (אות אות), הוה אומר שבסמך ארוך יקח לו המון זמן, לכן אני עשיתי את זה דרך חפש החלף

אבל ניסיתי שלך וזה לא עובד.

[menajemmendel]

@מניין כתב בבקשת מידע | הקטנה של כמה גדלים בחצי מספר:

אבל ניסיתי שלך וזה לא עובד.

מעניין לי כן עובד