בקשת מידע | המרת מרווח בין שורות בוורד מ'בודד'/'מרובה' וכו' ל'מדויק'

[שלמה11]

@shishko זה יוצא קטן מדי
הקוד שצריך להיות הוא בערך ככה:
גובה הפיסקה לחלק לגובה השורות פחות גובה הטקסט שווה למרווח בין השורות
ניסיתי לשאול את gpt אבל גם הוא לא הצליח להביא משהו מדויק

[shishko]

@שלמה11

Sub החלפת_מרווח_שורות_מבודד_למדויק()
    Dim fontSize As Single
    Dim correctionFactor As Single
    
    correctionFactor = 1.155
    
    ' קבלת גודל הגופן הנוכחי
    fontSize = Selection.Font.Size
    
    Dim adjustedSpacing As Single
    adjustedSpacing = fontSize * correctionFactor
    
    ' הגדרת מרווח השורות ל-"מדויק"
    With Selection.ParagraphFormat
        .LineSpacingRule = wdLineSpaceExactly
        .lineSpacing = adjustedSpacing
    End With
    
    MsgBox "מרווח השורות הוקבע ל-" & Round(adjustedSpacing, 2) & " נקודות בדיוק."
End Sub

זה כמעט מדויק ההפרש לא משמעותי נסה את זה ותעדכן אם מספק אותך

[shishko]

@שלמה11 האמת שזה הכי פשוט ועובד מצויין

Sub החלפת_מרווח_שורות_מבודד_למדויק()
    With Selection.ParagraphFormat
        .LineSpacingRule = wdLineSpaceExactly
        .lineSpacing = Selection.Font.Size * 1.155
    End With
End Sub

[שלמה11]

@shishko תודה רבה
אבל נראה לי שזה עובד בפונט אריאל בלבד

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

[shishko]

@שלמה11 מה זה עושה בפונטים האחרים

[שלמה11]

@shishko תלוי
אם הפונט גבוה יותר אז הרווח בין השורות יהיה קטן יותר
אם הפונט נמוך יותר אז הרווח בין השורות יהיה גדול יותר
(גם אם תעשה את הפונט באותו גובה של נק' עדיין יש פער בין פונט אחד לשני)
נראה לי שמצאתי פיתרון אני בודק אותו...

[shishko]

@שלמה11

Sub החלפת_מרווח_שורות_ישיר()
    With Selection.ParagraphFormat
        .LineSpacingRule = wdLineSpaceExactly
        
        ' חישוב המרווח האופטימלי לפי גובה הגופן ומאפייניו
        Dim optimalSpacing As Double
        Dim fontSize As Double
        fontSize = Selection.Font.Size
        
        ' התאמה לפי סוג הגופן
        Select Case Selection.Font.Name
            Case "Arial"
                optimalSpacing = fontSize * 1.155
            Case "David", "דוד"
                optimalSpacing = fontSize * 1.2
            Case "Times New Roman"
                optimalSpacing = fontSize * 1.15
            Case "Narkisim", "נרקיסים"
                optimalSpacing = fontSize * 1.18
            Case "Tahoma"
                optimalSpacing = fontSize * 1.16
            Case "Calibri"
                optimalSpacing = fontSize * 1.15
            Case "Helvetica"
                optimalSpacing = fontSize * 1.16
            Case "Verdana"
                optimalSpacing = fontSize * 1.17
            Case "Frank Ruehl", "פרנק-ריהל"
                optimalSpacing = fontSize * 1.19
            Case Else
                ' ברירת מחדל חכמה לגופנים אחרים
                If Selection.Font.Name Like "*Serif*" Or _
                   Selection.Font.Name Like "*דוד*" Or _
                   Selection.Font.Name Like "*נרקיס*" Or _
                   Selection.Font.Name Like "*פרנק*" Then
                    optimalSpacing = fontSize * 1.2
                Else
                    optimalSpacing = fontSize * 1.16
                End If
        End Select
        
        ' התאמות נוספות לפי מאפייני הטקסט
        If Selection.Font.Bold Then
            optimalSpacing = optimalSpacing * 1.02
        End If
        
        If fontSize <= 10 Then
            optimalSpacing = optimalSpacing * 1.02
        ElseIf fontSize >= 16 Then
            optimalSpacing = optimalSpacing * 0.98
        End If
        
        ' יישום המרווח המחושב
        .LineSpacing = optimalSpacing
    End With
End Sub

נסה את זה נראה לי מושלם כולל ברירת מחדל לכתבים מסויימים ובניה עצמית לכתבים אחרים

[שלמה11]

@shishko הנה הקוד:

Sub המרת_מרווח_בין_שורות_למדויק()
    Dim rng As Range
    Dim paragraphTop As Single
    Dim paragraphBottom As Single
    Dim paragraphHeight As Single
    Dim currentParagraph As Paragraph
    Dim lineCount As Long
    Dim Exactspacing As Double
    
    
    ' קבלת הפיסקה הנוכחית
    Set currentParagraph = Selection.Paragraphs(1)
    
    ' בחירת כל הפיסקה הנוכחית
    currentParagraph.Range.Select

    'הגדרת טווח לפסקה הראשונה
    Set rng = Selection.Range

    ' קבלת המיקום העליון של הפסקה
    paragraphTop = rng.Information(wdVerticalPositionRelativeToPage)
    
    ' קבלת המיקום התחתון של הפיסקה
    Selection.Move Unit:=wdCharacter, Count:=1
    Selection.Move Unit:=wdCharacter, Count:=-1
    paragraphBottom = Selection.Information(wdVerticalPositionRelativeToPage)

    ' חישוב גובה הפסקה
    paragraphHeight = paragraphBottom - paragraphTop
    
    ' חישוב מספר השורות בפיסקה
    lineCount = Selection.Paragraphs(1).Range.ComputeStatistics(wdStatisticLines)
    
    Exactspacing = paragraphHeight / (lineCount - 1)
     With Selection.ParagraphFormat
        .LineSpacingRule = wdLineSpaceExactly
        .lineSpacing = Exactspacing
    End With
End Sub

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

[מניין]

@שלמה11 כתב ב[בקשת מידע | המרת מרווח בין שורות בוורד

(יש מה לשפר... כי הפיסקה אומנם לא מזיזה את הפיסקאות האחרות, אבל המילים כן זזות קצת יותר למטה)

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

[שלמה11]

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

Spoiler

אבל זמן חורף מתחיל...

[מניין]

@שלמה11 כתב בבקשת מידע | המרת מרווח בין שורות בוורד מ'בודד'/'מרובה' וכו' ל'מדויק':

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

Spoiler

אבל זמן חורף מתחיל...

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