עזרה | שינוי רוחב טורים בכמה מקטעים

[איש גמזו]

@975 אם אני בוחר הכל הוא לא נותן לי לפתוח את תיבת ״טורים נוספים״ ואני לא יכול לשחק עם המרווח.

דחוף!!!
אם מישהו יכול לעזור ע״י כתיבת מאקרו או עצה נכונה (המאקרו שג׳ימיני כתב לי לא עבד)
@pcinfogmach

[975]

פוסט זה נמחק!

[איש גמזו]

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

[975]

פוסט זה נמחק!

[pcinfogmach]

Sub Test()
    Dim i As Integer
    For i = 1 To ActiveDocument.Sections.Count
        With ActiveDocument.Sections(i).PageSetup.TextColumns
            If .Count = 2 Then .Spacing = CentimetersToPoints(3) 'פה יש להזין את המרווח בסנטימטרים
        End With
    Next i
End Sub

[975]

@pcinfogmach אולי כדאי להכניס את זה לאוסף המקרואים

[איש גמזו]

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

[pcinfogmach]

@איש-גמזו

תחליף את ה-3 ב-0.8

[איש גמזו]

@pcinfogmach הוא נותן לי איזו שגיאה ומקיף את השורה באדום
‎⁨צילום מסך 2025-10-22 ב-17.53.38⁩
אולי בגלל שאני על מק? לנסות לעשות את זה על ווינדוס?

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

[pcinfogmach]

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

Sub Test()
    Dim i As Integer
    Dim userInput As String
    Dim spacingCm As Double
    
    ' בקשת קלט מהמשתמש
    userInput = InputBox("הזן את המרווח בין הטורים (בסנטימטרים):", "מרווח טורים", "0.8")
    
    ' בדיקה שהקלט תקין
    If IsNumeric(userInput) Then
        spacingCm = CDbl(userInput)
    Else
        MsgBox "אנא הזן מספר תקין.", vbExclamation
        Exit Sub
    End If
    
    ' הגדרת המרווח
    For i = 1 To ActiveDocument.Sections.Count
        With ActiveDocument.Sections(i).PageSetup.TextColumns
            If .Count = 2 Then .Spacing = CmToPoints(spacingCm)
        End With
    Next i
End Sub

' פונקציה שממירה ס"מ לנקודות (תואמת ל-Mac ול-Windows)
Function CmToPoints(cm As Double) As Double
    CmToPoints = cm * 28.35
End Function