דילוג לתוכן
  • חוקי הפורום
  • פופולרי
  • לא נפתר
  • משתמשים
  • חיפוש גוגל בפורום
  • צור קשר
עיצובים
  • Light
  • Cerulean
  • Cosmo
  • Flatly
  • Journal
  • Litera
  • Lumen
  • Lux
  • Materia
  • Minty
  • Morph
  • Pulse
  • Sandstone
  • Simplex
  • Sketchy
  • Spacelab
  • United
  • Yeti
  • Zephyr
  • Dark
  • Cyborg
  • Darkly
  • Quartz
  • Slate
  • Solar
  • Superhero
  • Vapor

  • ברירת מחדל (ללא עיצוב (ברירת מחדל))
  • ללא עיצוב (ברירת מחדל)
כיווץ
מתמחים טופ
  1. דף הבית
  2. תוכנות
  3. יישומי אופיס
  4. אקסל
  5. VBA - excel
  6. עזרה הדדית - VBA excel
  7. שיתוף | יישור טורים מאקרו חדש!!!

שיתוף | יישור טורים מאקרו חדש!!!

מתוזמן נעוץ נעול הועבר עזרה הדדית - VBA excel
61 פוסטים 16 כותבים 2.7k צפיות 18 עוקבים
  • מהישן לחדש
  • מהחדש לישן
  • הכי הרבה הצבעות
תגובה
  • תגובה כנושא
התחברו כדי לפרסם תגובה
נושא זה נמחק. רק משתמשים עם הרשאות מתאימות יוכלו לצפות בו.
  • א א.מ.

    @רפרם-ב-ר-פפא החלתי את המאקרו על פיסקה עם מסגרת (כבתמונה) וזה החזיר את שגיאה הבאה:

    b9dda539-0235-4dd6-96f1-18026c7ea31c-image.png
    eb93104c-db20-4142-97c0-5b6ddceb5086-image.png
    יש לך אולי דרך לסדר גם את זה?
    תזכו למצוות!

    ש מנותק
    ש מנותק
    שקוע בלימוד 0
    כתב ב נערך לאחרונה על ידי
    #18

    @א-מ איך עשית את ה'צורת הדף'?

    תגובה 1 תגובה אחרונה
    0
    • ר רפרם ב"ר פפא

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

      א מנותק
      א מנותק
      א.מ.
      מדריכים
      כתב ב נערך לאחרונה על ידי
      #19

      @רפרם-ב-ר-פפא כתב בשיתוף | יישור טורים מאקרו חדש!!!:

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

      יש שם שני טורים בעמוד, לא חשוב.
      תודה בכל אופן.

      @שקוע-בלימוד-0 כתב בשיתוף | יישור טורים מאקרו חדש!!!:

      @א-מ איך עשית את ה'צורת הדף'?

      עם "עזרים לוורד".

      menajemmendelM תגובה 1 תגובה אחרונה
      0
      • ר רפרם ב"ר פפא

        חדש! מאקרו ליישור טורים
        והפעם בקוד פתוח לצורך שיפור המאקרו ע"י כל החברים
        להערות הארות נא לדווח
        וכן כל דבר שיכול לשפר את הפעולה
        מצורף קובץ תבנית וורד אם אפשרות ליישור עמוד 1 או יישור כל המסמך
        עדכון אדר תשפ"ג
        יישור טורים 3.dotm

        וכן הקוד שכתבתי

        Public Sub יישור_טורים()
        'בודק אם יש שני טורים
        If Selection.PageSetup.TextColumns.Count <> 2 Then MsgBox ("לא נמצאו 2 טורים"): Exit Sub
        'עדכון מסך שקר
        Application.ScreenUpdating = False
        Dim WRange, Endcol2, Startcol1, Rcol1, Rcol2 As Range
        Dim NumLines, WPage, Pcol1, Pcol2, APcol, PPS, a, i, B, C, P, S, col1, col2, Acol, Ignore As Double
        
        'שומר תחילת שורה של מיקום נוכחי
        Selection.HomeKey Unit:=wdLine
        Set My = Selection.Range
        'תחילת עמוד
        Set WRange = ActiveDocument.Bookmarks("\page").Range
        WRange.SetRange Start:=WRange.Start, End:=WRange.Start + 1
        WRange.Select
        Set Startpage = Selection.Range
        WRange.SetRange Start:=Startpage.End, End:=My.End
        'סופר שורות
        WRange.Select
        SLines = Selection.Range.ComputeStatistics(wdStatisticLines)
        'חוזר ומפעיל לולאת בדיקה שאין כותרת'
        My.Select
        'Startcol1 מגדיר תחילת טור 1
        For S = 1 To SLines - 1
            Selection.GoTo What:=wdGoToLine, Which:=wdGoToPrevious, Count:=1, Name:=""
             If Selection.PageSetup.TextColumns.Count <> 2 Then
                Exit For
            Else
                Set Startcol1 = Selection.Range
            End If
        Next
        'סוף עמוד
        Set WRange = ActiveDocument.Bookmarks("\page").Range
        WRange.SetRange Start:=WRange.End - 1, End:=WRange.End
        WRange.Select
        Set Endpage = Selection.Range
        WRange.SetRange Start:=My.Start, End:=Endpage.End
        'סופר שורות
        WRange.Select
        ELines = Selection.Range.ComputeStatistics(wdStatisticLines)
        My.Select
        'Endcol2 מגדיר סוף טור 2
        For S = 1 To ELines - 1
            Selection.GoTo What:=wdGoToLine, Which:=wdGoToNext, Count:=1, Name:=""
             If Selection.PageSetup.TextColumns.Count <> 2 Then
                Exit For
            Else
                Set Endcol2 = Selection.Range
            End If
        Next
        
        'מספר שורות כולל שני טורים
        Set WRange = Selection.Range
        WRange.SetRange Start:=Startcol1.End, End:=Endcol2.End
        WRange.Select
        NumLines = Selection.Range.ComputeStatistics(wdStatisticLines)
        ' - col2 מגדיר גובה טור 2
        Endcol2.Select
        col2 = Endcol2.Information(wdVerticalPositionRelativeToPage)
        Selection.EndKey Unit:=wdLine
        Set Endcol2 = Selection.Range
        
        
        '  col1מגדיר גובה טור -1
        'Endcol1- סוף טור 1
        'Startcol2- תחילת טור2
        
        Startcol1.Select
        For i = 1 To NumLines
            Selection.GoTo What:=wdGoToLine, Which:=wdGoToNext, Count:=1, Name:=""
           If col1 > Selection.Information(wdVerticalPositionRelativeToPage) Then
          Set Startcol2 = Selection.Range
                Exit For
            Else
                col1 = Selection.Information(wdVerticalPositionRelativeToPage)
               Set Endcol1 = Selection.Range
            End If
            
        Next
        'סוף טור 1 = סוף שורה
        Endcol1.Select
        Selection.EndKey Unit:=wdLine
        Set Endcol1 = Selection.Range
        
        'Acol מגדיר הפרש בין טורים
                If col1 > col2 Then Acol = col1 - col2
                If col1 < col2 Then Acol = col2 - col1
            
            'בודק אם טורים ישרים
        
          If Acol < 0.05 Then
            MsgBox "טורים ישרים"
         'אם רווח גדול מידי מוסיף בסוף פסקה בטור 1
           ElseIf Acol > 50 Then
           Endcol2.Select
         ActiveDocument.Range(Start:=Selection.Start, End:=Selection.Start). _
                InsertBreak Type:=wdSectionBreakContinuous
            Selection.Start = Selection.Start + 1
        ActiveDocument.Range(Start:=Selection.End, End:=Selection.End).InsertBreak _
                 Type:=wdSectionBreakContinuous
            With Selection.PageSetup.TextColumns
                .SetCount NumColumns:=1
                .EvenlySpaced = True
                .LineBetween = False
            End With
            
           ElseIf Acol > 0.05 Then
            
        'Pcol1 - מספר פסקאות טור 1
            WRange.SetRange Start:=Startcol1.Start, End:=Endcol1.End - 2
            WRange.Select
           Set Rcol1 = Selection.Range
             Rcol1.Select
          Pcol1 = (Rcol1.ComputeStatistics(wdStatisticParagraphs))
        
        'Pcol2 - מספר פסקאות טור 2
            WRange.SetRange Start:=Startcol2.Start, End:=Endcol2.End - 2
            WRange.Select
            Set Rcol2 = Selection.Range
             Rcol2.Select
           Pcol2 = (Rcol2.ComputeStatistics(wdStatisticParagraphs))
        'טור מרובה פסקאות
        If Pcol1 > Pcol2 Then
        'עורך טור1
          
        ' PPS - מחלק הפרש בין פסקאות
            PPS = Acol / Pcol1
         'עבור לשורה ראשונה בטור
          Startcol1.Select
          'מפעיל פקודת תיקון בלולאה *מס' פסקאות
            For P = 1 To Pcol1
        'אם
         If col1 > col2 Then
        'מקטין רווח אחרי פסקה
              With Selection
               For B = 1 To .Paragraphs.Count
              .Paragraphs(B).Format.SpaceAfter = .Paragraphs(B).Format.SpaceAfter - PPS
               Next B
              End With
          'עבור לפסקה הבאה
             Selection.MoveDown wdParagraph, 1
        ElseIf col1 < col2 Then
        'מוסיף רווח אחרי פסקה
             With Selection
            For B = 1 To .Paragraphs.Count
            .Paragraphs(B).Format.SpaceAfter = .Paragraphs(B).Format.SpaceAfter + PPS
            Next B
             End With
          'עבור לפסקה הבאה
             Selection.MoveDown wdParagraph, 1
            End If
            Next
            
        Else
         'עורך טור 2
        
        'מחלק הפרש בין פסקאות
            PPS = Acol / Pcol2
            'עבור לשורה ראשונה בטור 2
                Startcol2.Select
          'מפעיל פקודת תיקון בלולאה *מס' פסקאות
            For P = 1 To Pcol2
        
            If col1 > col2 Then
        'מוסיף רווח אחרי פסקה
             With Selection
            For B = 1 To .Paragraphs.Count
            .Paragraphs(B).Format.SpaceAfter = .Paragraphs(B).Format.SpaceAfter + PPS
            Next B
          End With
          'עבור לפסקה הבאה
          Selection.MoveDown wdParagraph, 1
           ElseIf col1 < col2 Then
        'מקטין רווח אחרי פסקה
          With Selection
            For B = 1 To .Paragraphs.Count
            .Paragraphs(B).Format.SpaceAfter = .Paragraphs(B).Format.SpaceAfter - PPS
            Next B
          End With
          'עבור לפסקה הבאה
          Selection.MoveDown wdParagraph, 1
           
           End If
            Next
           End If
           End If
           Application.ScreenUpdating = True
        End Sub
        
        P מנותק
        P מנותק
        pcinfogmach
        מדריכים
        כתב ב נערך לאחרונה על ידי
        #20

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

        ושוב תודה

        גמ"ח עזרה וייעוץ בנושאי מחשבים

        ר תגובה 1 תגובה אחרונה
        0
        • P pcinfogmach

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

          ושוב תודה

          ר מנותק
          ר מנותק
          רפרם ב"ר פפא
          כתב ב נערך לאחרונה על ידי
          #21

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

          P תגובה 1 תגובה אחרונה
          0
          • ר רפרם ב"ר פפא

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

            P מנותק
            P מנותק
            pcinfogmach
            מדריכים
            כתב ב נערך לאחרונה על ידי
            #22

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

            אגב מה עם הבאג?

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

            גמ"ח עזרה וייעוץ בנושאי מחשבים

            ר תגובה 1 תגובה אחרונה
            0
            • P pcinfogmach

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

              אגב מה עם הבאג?

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

              ר מנותק
              ר מנותק
              רפרם ב"ר פפא
              כתב ב נערך לאחרונה על ידי
              #23

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

              תגובה 1 תגובה אחרונה
              0
              • P מנותק
                P מנותק
                pcinfogmach
                מדריכים
                כתב ב נערך לאחרונה על ידי
                #24

                @רפרם-ב-ר-פפא
                אה! יפה מאוד!
                אז היישור טורים עובד רק אם אין כותרות...
                הצורה לפתור את הבעיה של הכותרות היא על ידי הגדרת מרווח בין שורות (בהגדרות פיסקה) ל- מדוייק. אולי כדאי להוסיף את זה למאקרו.

                בקשר לבאג מצו"ב: (תכל'ס המאקרו עובד גם עם הבאג רק קצת מעצבן שיש הודעת שגיאה:
                d22c0bc9-8d5b-4b44-bd95-fa75a709c001-image.png
                6be93ac6-f087-4aa0-96c0-9dc7381e125d-image.png

                גמ"ח עזרה וייעוץ בנושאי מחשבים

                ר תגובה 1 תגובה אחרונה
                0
                • P pcinfogmach

                  @רפרם-ב-ר-פפא
                  אה! יפה מאוד!
                  אז היישור טורים עובד רק אם אין כותרות...
                  הצורה לפתור את הבעיה של הכותרות היא על ידי הגדרת מרווח בין שורות (בהגדרות פיסקה) ל- מדוייק. אולי כדאי להוסיף את זה למאקרו.

                  בקשר לבאג מצו"ב: (תכל'ס המאקרו עובד גם עם הבאג רק קצת מעצבן שיש הודעת שגיאה:
                  d22c0bc9-8d5b-4b44-bd95-fa75a709c001-image.png
                  6be93ac6-f087-4aa0-96c0-9dc7381e125d-image.png

                  ר מנותק
                  ר מנותק
                  רפרם ב"ר פפא
                  כתב ב נערך לאחרונה על ידי
                  #25

                  @pcinfogmach
                  המאקרו עובד גם אם יש כותרות אלא כשאין מה לחלק הוא לא יכול לחלק ולהוסיף או להוריד כי מחשבן את המרוח בין פסקאות ומחלק ו0 שווה 0
                  ובעניין הבאג הוא כיוון שלפעמים יש צורך בחלוקה מתחת ל0 (כגון שהמרווח בין פסקאות 10 וישנם שני פסקאות והפרש בין טורים 25 וכשמחלק להוריד 12.5 לכל מקטע נתקע שאינו יכול להיות פחות מ0
                  ובדרך כלל לא מגיע לזה ועוד יש לי רעיון בעניין ובעז"ה אם יואיל למישהו אעשה כשיהיה איתותי בידי
                  בהצלחה ובהנאה

                  P תגובה 1 תגובה אחרונה
                  0
                  • ר רפרם ב"ר פפא

                    @pcinfogmach
                    המאקרו עובד גם אם יש כותרות אלא כשאין מה לחלק הוא לא יכול לחלק ולהוסיף או להוריד כי מחשבן את המרוח בין פסקאות ומחלק ו0 שווה 0
                    ובעניין הבאג הוא כיוון שלפעמים יש צורך בחלוקה מתחת ל0 (כגון שהמרווח בין פסקאות 10 וישנם שני פסקאות והפרש בין טורים 25 וכשמחלק להוריד 12.5 לכל מקטע נתקע שאינו יכול להיות פחות מ0
                    ובדרך כלל לא מגיע לזה ועוד יש לי רעיון בעניין ובעז"ה אם יואיל למישהו אעשה כשיהיה איתותי בידי
                    בהצלחה ובהנאה

                    P מנותק
                    P מנותק
                    pcinfogmach
                    מדריכים
                    כתב ב נערך לאחרונה על ידי
                    #26

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

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

                    גמ"ח עזרה וייעוץ בנושאי מחשבים

                    ר תגובה 1 תגובה אחרונה
                    0
                    • P pcinfogmach

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

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

                      ר מנותק
                      ר מנותק
                      רפרם ב"ר פפא
                      כתב ב נערך לאחרונה על ידי
                      #27

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

                      P M 2 תגובות תגובה אחרונה
                      1
                      • ר רפרם ב"ר פפא

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

                        P מנותק
                        P מנותק
                        pcinfogmach
                        מדריכים
                        כתב ב נערך לאחרונה על ידי
                        #28

                        @רפרם-ב-ר-פפא
                        אלוף! ושוב תודה

                        גמ"ח עזרה וייעוץ בנושאי מחשבים

                        ר תגובה 1 תגובה אחרונה
                        0
                        • ר רפרם ב"ר פפא

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

                          M מנותק
                          M מנותק
                          mfmf
                          כתב ב נערך לאחרונה על ידי mfmf
                          #29

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

                          ר תגובה 1 תגובה אחרונה
                          0
                          • M mfmf

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

                            ר מנותק
                            ר מנותק
                            רפרם ב"ר פפא
                            כתב ב נערך לאחרונה על ידי
                            #30

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

                            M תגובה 1 תגובה אחרונה
                            5
                            • ר רפרם ב"ר פפא

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

                              M מנותק
                              M מנותק
                              mfmf
                              כתב ב נערך לאחרונה על ידי
                              #31

                              @רפרם-ב-ר-פפא
                              אם יש 2 טורים בראש העמוד, כותרת באמצע העמוד על פני כל הרוחב ואח"כ שוב 2 טורים, המאקרו מסדר רק את הטורים שאחרי הכותרת ולא את הטורים שלפני הכותרת.

                              ר תגובה 1 תגובה אחרונה
                              0
                              • M mfmf

                                @רפרם-ב-ר-פפא
                                אם יש 2 טורים בראש העמוד, כותרת באמצע העמוד על פני כל הרוחב ואח"כ שוב 2 טורים, המאקרו מסדר רק את הטורים שאחרי הכותרת ולא את הטורים שלפני הכותרת.

                                ר מנותק
                                ר מנותק
                                רפרם ב"ר פפא
                                כתב ב נערך לאחרונה על ידי
                                #32

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

                                M תגובה 1 תגובה אחרונה
                                2
                                • ר רפרם ב"ר פפא

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

                                  M מנותק
                                  M מנותק
                                  mfmf
                                  כתב ב נערך לאחרונה על ידי
                                  #33

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

                                  תגובה 1 תגובה אחרונה
                                  0
                                  • P pcinfogmach

                                    @רפרם-ב-ר-פפא
                                    אלוף! ושוב תודה

                                    ר מנותק
                                    ר מנותק
                                    רפרם ב"ר פפא
                                    כתב ב נערך לאחרונה על ידי רפרם ב"ר פפא
                                    #34

                                    בסייעתא דשמיא
                                    עדכון המאקרו יישור טורים - תוספות ותיקונים
                                    בהמשך להערות וההארות שנכתבו בשרשור זה בסייעתא דשמיא הנני להציע לציבור היקר את מאקרו יישור טורים גרסה 3
                                    א.סודר ענין השגיאה של מרווח פחות מ0
                                    וכמו כן נקבע שמרווח בין פסקאות לא יוכל לחרוג מטווח של 2.5 נקודות מינימום ו25 נקודת מקסימום (וזה לצורך הנראות הבסיסית) ונוסף גם שכשלא מצליח בטור הראשון (שהוא רב בפסקאות לעומת השני) מנסה בטור השני (ואם בשני טורים לא עומד בכללים אז ביישור מסמך שלם או מספר עמודים מדלג באופן אוטומטי לעמוד הבא וביישור עמוד אחד מודיע שלא עומד בכללים שהוצבו)
                                    ב. כמו כן מדלג על מסגרות ותיבות טקסט
                                    (ג. כמו כן מאחר שהוגדר מינימום 2.5 נקודות ממילא לא תהיה בעיה של עובי כתב בכותרת)
                                    ד. נוסף פקודה יישור ממיקום הסמן עד סוף כל המסמך (וטוב במקרה של באג וכו לדלג על המקום הבעייתי)
                                    ה. נוסף פקודה ליישור מכותרת על טור 1 עד כותרת הבאה (דהיינו סימן אחד בקונטרס)
                                    ו. ביישור כל המסמך במקרה שיש כותרת באמצע עמוד מיישר גם את החלק העליון וגם את התחתון
                                    בהצלחה
                                    ואשמח לשמוע אם עובד כמצופה וכן על באגים שלא יהיו וכן הצעות ייעול
                                    נראה שהוא דבר שיכול להועיל להרבה משתמשים ולחסוך זמן לכן אני מקווה לעשות כתוסף לכשיהיה מושלם
                                    וכן בכוונתי להוסיף אפשרות להגדיר את הטווח מינימום ומקסימום ועוד בל"נ
                                    הכל בעזרתו יתברך ובישועתו
                                    מצ"ב הקובץיישור טורים 3.dotm ועודכן בפוסט הראשי

                                    והקוד המתוקן והמשופץ
                                    ליישור עמוד אחד

                                    
                                    Dim WRange, Endcol2, Startcol1, Rcol1, Rcol2 As Range
                                    Dim NumLines, WPage, Pcol1, Pcol2, APcol, PPS, a, i, B, C, LM, P, S, V, col1, col2, Acol, Ignore As Double
                                    
                                    Public Sub יישור_טורים_עמוד_זה()
                                    
                                    'בודק אם יש שני טורים
                                    If Selection.PageSetup.TextColumns.Count <> 2 Then MsgBox ("לא נמצאו 2 טורים"): Exit Sub
                                    'עדכון מסך שקר
                                    Application.ScreenUpdating = False
                                    Dim WRange, Endcol2, Startcol1, Rcol1, Rcol2 As Range
                                    Dim NumLines, WPage, Pcol1, Pcol2, APcol, PPS, a, i, B, C, LM, P, S, V, col1, col2, Acol, Ignore As Double
                                    
                                    'שומר תחילת שורה של מיקום נוכחי
                                    Selection.HomeKey Unit:=wdLine
                                    Set My = Selection.Range
                                    
                                    'בחר את כל העמוד
                                    Set WRange = ActiveDocument.Bookmarks("\page").Range
                                    
                                    'עובר לתחילת עמוד
                                    WRange.SetRange Start:=WRange.Start, End:=WRange.Start + 1
                                    WRange.Select
                                    Set Startpage = Selection.Range
                                    WRange.SetRange Start:=Startpage.End, End:=My.End
                                    'סופר שורות
                                    WRange.Select
                                    SLines = Selection.Range.ComputeStatistics(wdStatisticLines)
                                    'חוזר ומפעיל לולאת בדיקה שאין כותרת'
                                    My.Select
                                    'Startcol1 מגדיר תחילת טור 1
                                      Set Startcol1 = Selection.Range
                                    For S = 1 To SLines - 1
                                        Selection.GoTo What:=wdGoToLine, Which:=wdGoToPrevious, Count:=1, Name:=""
                                         If Selection.PageSetup.TextColumns.Count <> 2 Then
                                            Exit For
                                        Else
                                            Set Startcol1 = Selection.Range
                                        End If
                                    Next
                                    'סוף עמוד
                                    Set WRange = ActiveDocument.Bookmarks("\page").Range
                                    WRange.SetRange Start:=WRange.End - 1, End:=WRange.End
                                    WRange.Select
                                    Set Endpage = Selection.Range
                                    WRange.SetRange Start:=My.Start, End:=Endpage.End
                                    'סופר שורות
                                    WRange.Select
                                    ELines = Selection.Range.ComputeStatistics(wdStatisticLines)
                                    My.Select
                                    'Endcol2 מגדיר סוף טור 2
                                    Set Endcol2 = Selection.Range
                                    For S = 1 To ELines - 1
                                        Selection.GoTo What:=wdGoToLine, Which:=wdGoToNext, Count:=1, Name:=""
                                         If Selection.PageSetup.TextColumns.Count <> 2 Then
                                            Exit For
                                        Else
                                            Set Endcol2 = Selection.Range
                                        End If
                                    Next
                                    
                                    'מספר שורות כולל שני טורים
                                    Set WRange = Selection.Range
                                    WRange.SetRange Start:=Startcol1.End, End:=Endcol2.End
                                    WRange.Select
                                    NumLines = Selection.Range.ComputeStatistics(wdStatisticLines)
                                    ' - col2 מגדיר גובה טור 2
                                    Endcol2.Select
                                    col2 = Endcol2.Information(wdVerticalPositionRelativeToPage)
                                    Selection.EndKey Unit:=wdLine
                                    Set Endcol2 = Selection.Range
                                    
                                    
                                    '  col1מגדיר גובה טור =1
                                    'Endcol1= סוף טור 1
                                    'Startcol2= תחילת טור2
                                    
                                    Startcol1.Select
                                    For i = 1 To NumLines
                                        Selection.GoTo What:=wdGoToLine, Which:=wdGoToNext, Count:=1, Name:=""
                                       If col1 > Selection.Information(wdVerticalPositionRelativeToPage) Then
                                      Set Startcol2 = Selection.Range
                                            Exit For
                                        Else
                                            col1 = Selection.Information(wdVerticalPositionRelativeToPage)
                                           Set Endcol1 = Selection.Range
                                        End If
                                        
                                    Next
                                    'סוף טור 1 = סוף שורה
                                    Endcol1.Select
                                    Selection.EndKey Unit:=wdLine
                                    Set Endcol1 = Selection.Range
                                    
                                    'Acol= מגדיר הפרש בין טורים
                                            If col1 > col2 Then Acol = col1 - col2
                                            If col1 < col2 Then Acol = col2 - col1
                                        
                                        'בודק אם טורים ישרים
                                    
                                      If Acol < 0.05 Then
                                        MsgBox "טורים ישרים"
                                     'אם רווח גדול מידי מוסיף בסוף פסקה מעבר מקטע בטור 1
                                       ElseIf Acol > 30 Then
                                       Endcol2.Select
                                     ActiveDocument.Range(Start:=Selection.Start, End:=Selection.Start). _
                                            InsertBreak Type:=wdSectionBreakContinuous
                                        Selection.Start = Selection.Start + 1
                                    ActiveDocument.Range(Start:=Selection.End, End:=Selection.End).InsertBreak _
                                             Type:=wdSectionBreakContinuous
                                        With Selection.PageSetup.TextColumns
                                            .SetCount NumColumns:=1
                                            .EvenlySpaced = True
                                            .LineBetween = False
                                        End With
                                        
                                       Else
                                        
                                    'Pcol1 = מספר פסקאות טור 1
                                        WRange.SetRange Start:=Startcol1.Start, End:=Endcol1.End - 2
                                        WRange.Select
                                       Set Rcol1 = Selection.Range
                                         Rcol1.Select
                                      Pcol1 = (Rcol1.ComputeStatistics(wdStatisticParagraphs))
                                    
                                    'Pcol2 = מספר פסקאות טור 2
                                        WRange.SetRange Start:=Startcol2.Start, End:=Endcol2.End - 2
                                        WRange.Select
                                        Set Rcol2 = Selection.Range
                                         Rcol2.Select
                                       Pcol2 = (Rcol2.ComputeStatistics(wdStatisticParagraphs))
                                    'טור מרובה פסקאות
                                    If Pcol1 > Pcol2 Then
                                    
                                            'עורך טור1
                                      
                                            ' PPS - מחלק הפרש בין פסקאות
                                                PPS = Acol / Pcol1
                                    
                                                 'עבור לשורה ראשונה בטור
                                                      Startcol1.Select
                                        
                                                    ' 'אם טור 1 ארוך מ2
                                                    If col1 > col2 Then
                                                      'בודק אם רווח לא קטן מ2.5
                                                      If SpaceAfter - PPS > 2.5 Then
                                                     'מפעיל פקודת תיקון בלולאה *מס' פסקאות
                                                        For P = 1 To Pcol1
                                     
                                                'מקטין רווח אחרי פסקה
                                                   With Selection
                                                           For B = 1 To .Paragraphs.Count
                                          
                                                      .Paragraphs(B).Format.SpaceAfter = .Paragraphs(B).Format.SpaceAfter - PPS
                                                       Next B
                                                     End With
                                            
                                                 'עבור לפסקה הבאה
                                                  Selection.MoveDown wdParagraph, 1
                                                  Next P
                                                    'אחרת עורך טור 2
                                                       Else
                                                       If Pcol2 = 0 Then
                                                        'אחרת עובר עמוד
                                                        
                                                     Endcol2.Select
                                                     Selection.MoveDown wdParagraph, 1
                                                     MsgBox ("לא עומד בקרטיונים שנקבעו נא נסה לערוך ידנית")
                                                     Else
                                                          PPS = Acol / Pcol2
                                                       'עבור לשורה ראשונה בטור 2
                                                        Startcol2.Select
                                      
                                                         'בודק אם רווח לא גדול מ25
                                    
                                                        If SpaceAfter + PPS < 25 Then
                                                       'מפעיל פקודת תיקון בלולאה *מס' פסקאות
                                                        For P = 1 To Pcol2
                                                    'מוסיף רווח אחרי פסקה
                                                       With Selection
                                                       For B = 1 To .Paragraphs.Count
                                                        .Paragraphs(B).Format.SpaceAfter = .Paragraphs(B).Format.SpaceAfter + PPS
                                                        Next B
                                                      End With
                                    
                                                     'עבור לפסקה הבאה
                                                      Selection.MoveDown wdParagraph, 1
                                                      Next P
                                       
                                                          'אחרת עובר עמוד
                                                        Else
                                                       'עבור לפסקה הבאה
                                                     Endcol2.Select
                                                     Selection.MoveDown wdParagraph, 1
                                                     MsgBox ("לא עומד בקרטיונים שנקבעו נא נסה לערוך ידנית")
                                                      End If
                                                       End If
                                              End If
                                        
                                                 'אם טור 2 ארוך מ1
                                                 ElseIf col1 < col2 Then
                                          
                                                        'בודק אם רווח לא גדול מ25
                                                         If SpaceAfter + PPS < 25 Then
                                                         'מפעיל פקודת תיקון בלולאה *מס' פסקאות
                                                        For P = 1 To Pcol1
                                                        'מוסיף רווח אחרי פסקה
                                                          With Selection
                                                          For B = 1 To .Paragraphs.Count
                                                            .Paragraphs(B).Format.SpaceAfter = .Paragraphs(B).Format.SpaceAfter + PPS
                                                         Next B
                                                          End With
                                         
                                                         'עבור לפסקה הבאה
                                                           Selection.MoveDown wdParagraph, 1
                                                        Next P
                                         
                                                        'אחרת שרווח יהיה גדול מ25 עורך טור 2
                                                         Else
                                                          If Pcol2 = 0 Then
                                                        'אחרת עובר עמוד
                                                        
                                                     Endcol2.Select
                                                     Selection.MoveDown wdParagraph, 1
                                                     MsgBox ("לא עומד בקרטיונים שנקבעו נא נסה לערוך ידנית")
                                                     Else
                                                          PPS = Acol / Pcol2
                                                           'עבור לשורה ראשונה בטור 2
                                                               Startcol2.Select
                                      
                                                             'בודק אם רווח לא קטן מ2.5
                                                             If SpaceAfter - PPS > 2.5 Then
                                        
                                                         'מפעיל פקודת תיקון בלולאה *מס' פסקאות
                                                            For P = 1 To Pcol2
                                                            'מקטין רווח אחרי פסקה
                                                          With Selection
                                                           For B = 1 To .Paragraphs.Count
                                                        .Paragraphs(B).Format.SpaceAfter = .Paragraphs(B).Format.SpaceAfter - PPS
                                                       Next B
                                                      End With
                                      
                                                     'עבור לפסקה הבאה
                                                      Selection.MoveDown wdParagraph, 1
                                                         Next P
                                      
                                                      'אחרת עובר עמוד
                                                          Else
                                                          'עבור לפסקה הבאה
                                                   Endcol2.Select
                                                     Selection.MoveDown wdParagraph, 1
                                                     MsgBox ("לא עומד בקרטיונים שנקבעו נא נסה לערוך ידנית")
                                                           End If
                                                           End If
                                                        End If
                                                         End If
                                        'אם טור 2 רב פסקאות או שווה
                                    ElseIf Pcol2 > Pcol1 Or Pcol2 = Pcol1 Then
                                    
                                            'עורך טור 2
                                    
                                                'מחלק הפרש בין פסקאות
                                        
                                                   PPS = Acol / Pcol2
                                               'עבור לשורה ראשונה בטור 2
                                                 Startcol2.Select
                                        
                                                'אם טור 1 ארוך מ2
                                                   If col1 > col2 Then
                                                          'בודק אם רווח לא גדול מ25
                                                          If SpaceAfter + PPS < 25 Then
                                          
                                                          'מפעיל פקודת תיקון בלולאה *מס' פסקאות
                                                           For P = 1 To Pcol2
                                      
                                                    'מוסיף רווח אחרי פסקה
                                                       With Selection
                                                      For B = 1 To .Paragraphs.Count
                                                       .Paragraphs(B).Format.SpaceAfter = .Paragraphs(B).Format.SpaceAfter + PPS
                                                        Next B
                                                      End With
                                     
                                      
                                                     'עבור לפסקה הבאה
                                                      Selection.MoveDown wdParagraph, 1
                                                           Next P
                                       
                                                     'אחרת עורך טור 1
                                                          Else
                                                       If Pcol1 = 0 Then
                                                        'אחרת עובר עמוד
                                                        
                                                     Endcol2.Select
                                                     Selection.MoveDown wdParagraph, 1
                                                     MsgBox ("לא עומד בקרטיונים שנקבעו נא נסה לערוך ידנית")
                                                     Else
                                                        ' PPS - מחלק הפרש בין פסקאות
                                                           PPS = Acol / Pcol1
                                    
                                                        'עבור לשורה ראשונה בטור
                                                              Startcol1.Select
                                    
                                                          'בודק אם רווח לא קטן מ2.5
                                                          If SpaceAfter - PPS > 2.5 Then
                                        
                                                           'מפעיל פקודת תיקון בלולאה *מס' פסקאות
                                                        For P = 1 To Pcol1
                                     
                                                        'מקטין רווח אחרי פסקה
                                                             With Selection
                                                              For B = 1 To .Paragraphs.Count
                                          
                                                                .Paragraphs(B).Format.SpaceAfter = .Paragraphs(B).Format.SpaceAfter - PPS
                                                                Next B
                                                                    End With
                                        
                                           
                                                                  'עבור לפסקה הבאה
                                                              Selection.MoveDown wdParagraph, 1
                                                                  Next P
                                                         'אחרת עובר עמוד
                                                          Else
                                                          'עבור לפסקה הבאה
                                                         Endcol2.Select
                                                         Selection.MoveDown wdParagraph, 1
                                                            MsgBox ("לא עומד בקרטיונים שנקבעו נא נסה לערוך ידנית")
                                                           End If
                                                            End If
                                              End If
                                             
                                          
                                                     'אם טור 2 ארוך מ1
                                                      ElseIf col2 > col1 Then
                                                           'בודק אם רווח לא קטן מ2.5
                                                               If SpaceAfter - PPS > 2.5 Then
                                        
                                                             'מפעיל פקודת תיקון בלולאה *מס' פסקאות
                                                              For P = 1 To Pcol2
                                     
                                                                'מקטין רווח אחרי פסקה
                                                              With Selection
                                                               For B = 1 To .Paragraphs.Count
                                                               .Paragraphs(B).Format.SpaceAfter = .Paragraphs(B).Format.SpaceAfter - PPS
                                                               Next B
                                                              End With
                                      
                                      
                                                             'עבור לפסקה הבאה
                                                          Selection.MoveDown wdParagraph, 1
                                                              Next P
                                      
                                                              'אחרת עורך טור 1
                                                               Else
                                            
                                                       If Pcol1 = 0 Then
                                                        'אחרת עובר עמוד
                                                        
                                                     Endcol2.Select
                                                     Selection.MoveDown wdParagraph, 1
                                                     MsgBox ("לא עומד בקרטיונים שנקבעו נא נסה לערוך ידנית")
                                                     Else
                                                                ' PPS - מחלק הפרש בין פסקאות
                                                                  PPS = Acol / Pcol1
                                    
                                                                     'עבור לשורה ראשונה בטור
                                                                      Startcol1.Select
                                      
                                                                     'בודק אם רווח לא  גדול מ25
                                                                        If SpaceAfter + PPS < 25 Then
                                                                         'מפעיל פקודת תיקון בלולאה *מס' פסקאות
                                                                          For P = 1 To Pcol1
                                     
                                                                        'מגדיל  רווח אחרי פסקה
                                                                         With Selection
                                                                          For B = 1 To .Paragraphs.Count
                                          
                                                                        .Paragraphs(B).Format.SpaceAfter = .Paragraphs(B).Format.SpaceAfter + PPS
                                                                           Next B
                                                                        End With
                                           
                                                                         'עבור לפסקה הבאה
                                                                          Selection.MoveDown wdParagraph, 1
                                                                           Next P
                                         
                                                                           'אחרת עובר עמוד
                                                                        Else
                                                                           'עבור לפסקה הבאה
                                                                             Endcol2.Select
                                                                             Selection.MoveDown wdParagraph, 1
                                                                            MsgBox ("לא עומד בקרטיונים שנקבעו נא נסה לערוך ידנית")
                                                                          End If
                                                                         End If
                                                                          End If
                                                       End If
                                                 End If
                                          End If
                                          
                                    
                                       My.Select
                                       
                                       Application.ScreenUpdating = True
                                    End Sub
                                    
                                    
                                    
                                    

                                    ליישור כל המסמך

                                    Dim WRange, Endcol1, Startcol1, Endcol2, Startcol2, Rcol1, Rcol2 As Range
                                    Dim NumLines, WPage, Pcol1, Pcol2, APcol, PPS, a, i, B, C, P, R, S, G, col1, col2, Acol, Ignore As Double
                                    
                                    Public Sub יישור_טורים_בכל_המסמך_חדש()
                                    'עדכון מסך שקר
                                    Application.ScreenUpdating = False
                                    'מספר פסקאות
                                    
                                    
                                    'תחילה בסוף מסמך מוסיף תו כטור 1
                                    Selection.WholeStory
                                    Set Whole = Selection.Range
                                    Whole.SetRange Start:=Whole.End, End:=Whole.End
                                    Whole.Select
                                    If Selection.PageSetup.TextColumns.Count = 2 Then
                                     ActiveDocument.Range(Start:=Selection.Start, End:=Selection.Start). _
                                            InsertBreak Type:=wdSectionBreakContinuous
                                        Selection.Start = Selection.Start + 1
                                    ActiveDocument.Range(Start:=Selection.End, End:=Selection.End).InsertBreak _
                                             Type:=wdSectionBreakContinuous
                                        With Selection.PageSetup.TextColumns
                                            .SetCount NumColumns:=1
                                            .EvenlySpaced = True
                                            .LineBetween = False
                                        End With
                                            Else
                                        End If
                                        'עובר לפסקה ראשונה
                                        ActiveDocument.Paragraphs(1).Range.Select
                                        'נכנס לללואה על כל המסמך
                                        For R = 1 To ActiveDocument.Paragraphs.Count / 3
                                    'בודק אם יש שני טורים
                                    If Selection.PageSetup.TextColumns.Count = 2 Then
                                           Application.Run MacroName:="עורך_טורים"
                                            Else
                                        Selection.MoveDown wdParagraph, 1
                                        End If
                                        
                                          Next R
                                         
                                       Application.ScreenUpdating = True
                                    End Sub
                                    
                                    Public Sub עורך_טורים()
                                    'עדכון מסך שקר
                                    Application.ScreenUpdating = False
                                    Dim WRange, Endcol2, Startcol1, Rcol1, Rcol2 As Range
                                    Dim NumLines, WPage, Pcol1, Pcol2, APcol, PPS, LM, a, i, B, C, P, S, col1, col2, Acol, Ignore As Double
                                    
                                    'שומר תחילת שורה של מיקום נוכחי
                                    Selection.HomeKey Unit:=wdLine
                                    Set My = Selection.Range
                                    
                                    'בחר את כל העמוד
                                    Set WRange = ActiveDocument.Bookmarks("\page").Range
                                    
                                    'עובר לתחילת עמוד
                                    WRange.SetRange Start:=WRange.Start, End:=WRange.Start + 1
                                    WRange.Select
                                    Set Startpage = Selection.Range
                                    WRange.SetRange Start:=Startpage.End, End:=My.End
                                    'סופר שורות
                                    WRange.Select
                                    SLines = Selection.Range.ComputeStatistics(wdStatisticLines)
                                    'חוזר ומפעיל לולאת בדיקה שאין כותרת'
                                    My.Select
                                    'Startcol1 מגדיר תחילת טור 1
                                    Set Startcol1 = Selection.Range
                                    For S = 1 To SLines - 1
                                        Selection.GoTo What:=wdGoToLine, Which:=wdGoToPrevious, Count:=1, Name:=""
                                         If Selection.PageSetup.TextColumns.Count <> 2 Then
                                            Exit For
                                        Else
                                            Set Startcol1 = Selection.Range
                                        End If
                                    Next
                                    'סוף עמוד
                                    Set WRange = ActiveDocument.Bookmarks("\page").Range
                                    WRange.SetRange Start:=WRange.End - 1, End:=WRange.End
                                    WRange.Select
                                    Set Endpage = Selection.Range
                                    WRange.SetRange Start:=My.Start, End:=Endpage.End
                                    'סופר שורות
                                    WRange.Select
                                    ELines = Selection.Range.ComputeStatistics(wdStatisticLines)
                                    My.Select
                                    'Endcol2מגדיר סוף טור 2
                                    Set Endcol2 = Selection.Range
                                    For S = 1 To ELines - 1
                                        Selection.GoTo What:=wdGoToLine, Which:=wdGoToNext, Count:=1, Name:=""
                                         If Selection.PageSetup.TextColumns.Count <> 2 Then
                                            Exit For
                                        Else
                                            Set Endcol2 = Selection.Range
                                        End If
                                    Next
                                    
                                    'מספר שורות כולל שני טורים
                                    Set WRange = Selection.Range
                                    WRange.SetRange Start:=Startcol1.End, End:=Endcol2.End
                                    WRange.Select
                                    NumLines = Selection.Range.ComputeStatistics(wdStatisticLines)
                                    ' - col2 מגדיר גובה טור 2
                                    Endcol2.Select
                                    col2 = Endcol2.Information(wdVerticalPositionRelativeToPage)
                                    Selection.EndKey Unit:=wdLine
                                    Set Endcol2 = Selection.Range
                                    
                                    
                                    '  col1מגדיר גובה טור -1
                                    'Endcol1- סוף טור 1
                                    'Startcol2- תחילת טור2
                                    
                                    Startcol1.Select
                                    For i = 1 To NumLines
                                        Selection.GoTo What:=wdGoToLine, Which:=wdGoToNext, Count:=1, Name:=""
                                       If col1 > Selection.Information(wdVerticalPositionRelativeToPage) Then
                                      Set Startcol2 = Selection.Range
                                            Exit For
                                        Else
                                            col1 = Selection.Information(wdVerticalPositionRelativeToPage)
                                           Set Endcol1 = Selection.Range
                                        End If
                                        
                                    Next
                                    'סוף טור 1 = סוף שורה
                                    Endcol1.Select
                                    Selection.EndKey Unit:=wdLine
                                    Set Endcol1 = Selection.Range
                                    
                                    'Acol מגדיר הפרש בין טורים
                                            If col1 > col2 Then Acol = col1 - col2
                                            If col1 < col2 Then Acol = col2 - col1
                                        
                                        'בודק אם טורים ישרים
                                    
                                      If Acol < 0.05 Then
                                      'עובר לעמודה הבאה
                                      Endcol2.Select
                                         Selection.MoveDown wdParagraph, 1
                                          
                                       Else
                                        
                                    'Pcol1 - מספר פסקאות טור 1
                                        WRange.SetRange Start:=Startcol1.Start, End:=Endcol1.End - 2
                                        WRange.Select
                                       Set Rcol1 = Selection.Range
                                         Rcol1.Select
                                      Pcol1 = (Rcol1.ComputeStatistics(wdStatisticParagraphs))
                                    
                                    'Pcol2 - מספר פסקאות טור 2
                                        WRange.SetRange Start:=Startcol2.Start, End:=Endcol2.End - 2
                                        WRange.Select
                                        Set Rcol2 = Selection.Range
                                         Rcol2.Select
                                       Pcol2 = (Rcol2.ComputeStatistics(wdStatisticParagraphs))
                                    
                                    If Pcol1 > Pcol2 Then
                                    
                                            'עורך טור1
                                      
                                            ' PPS - מחלק הפרש בין פסקאות
                                                PPS = Acol / Pcol1
                                    
                                                 'עבור לשורה ראשונה בטור
                                                      Startcol1.Select
                                        
                                                    ' 'אם טור 1 ארוך מ2
                                                    If col1 > col2 Then
                                                      'בודק אם רווח לא קטן מ2.5
                                                      If SpaceAfter - PPS > 2.5 Then
                                                     'מפעיל פקודת תיקון בלולאה *מס' פסקאות
                                                        For P = 1 To Pcol1
                                     
                                                'מקטין רווח אחרי פסקה
                                                   With Selection
                                                           For B = 1 To .Paragraphs.Count
                                          
                                                      .Paragraphs(B).Format.SpaceAfter = .Paragraphs(B).Format.SpaceAfter - PPS
                                                       Next B
                                                     End With
                                            
                                                 'עבור לפסקה הבאה
                                                  Selection.MoveDown wdParagraph, 1
                                                  Next P
                                                    'אחרת עורך טור 2
                                                       Else
                                                       If Pcol2 = 0 Then
                                                        'אחרת עובר עמוד
                                                        
                                                     Endcol2.Select
                                                     Selection.MoveDown wdParagraph, 1
                                                     
                                                     Else
                                                          PPS = Acol / Pcol2
                                                       'עבור לשורה ראשונה בטור 2
                                                        Startcol2.Select
                                      
                                                         'בודק אם רווח לא גדול מ25
                                    
                                                        If SpaceAfter + PPS < 25 Then
                                                       'מפעיל פקודת תיקון בלולאה *מס' פסקאות
                                                        For P = 1 To Pcol2
                                                    'מוסיף רווח אחרי פסקה
                                                       With Selection
                                                       For B = 1 To .Paragraphs.Count
                                                        .Paragraphs(B).Format.SpaceAfter = .Paragraphs(B).Format.SpaceAfter + PPS
                                                        Next B
                                                      End With
                                    
                                                     'עבור לפסקה הבאה
                                                      Selection.MoveDown wdParagraph, 1
                                                      Next P
                                       
                                                          'אחרת עובר עמוד
                                                        Else
                                                       'עבור לפסקה הבאה
                                                     Endcol2.Select
                                                     Selection.MoveDown wdParagraph, 1
                                                      End If
                                                       End If
                                              End If
                                        
                                                 'אם טור 2 ארוך מ1
                                                 ElseIf col1 < col2 Then
                                          
                                                        'בודק אם רווח לא גדול מ25
                                                         If SpaceAfter + PPS < 25 Then
                                                         'מפעיל פקודת תיקון בלולאה *מס' פסקאות
                                                        For P = 1 To Pcol1
                                                        'מוסיף רווח אחרי פסקה
                                                          With Selection
                                                          For B = 1 To .Paragraphs.Count
                                                            .Paragraphs(B).Format.SpaceAfter = .Paragraphs(B).Format.SpaceAfter + PPS
                                                         Next B
                                                          End With
                                         
                                                         'עבור לפסקה הבאה
                                                           Selection.MoveDown wdParagraph, 1
                                                        Next P
                                         
                                                        'אחרת שרווח יהיה גדול מ25 עורך טור 2
                                                         Else
                                                          If Pcol2 = 0 Then
                                                        'אחרת עובר עמוד
                                                        
                                                     Endcol2.Select
                                                     Selection.MoveDown wdParagraph, 1
                                                     
                                                     Else
                                                          PPS = Acol / Pcol2
                                                           'עבור לשורה ראשונה בטור 2
                                                               Startcol2.Select
                                      
                                                             'בודק אם רווח לא קטן מ2.5
                                                             If SpaceAfter - PPS > 2.5 Then
                                        
                                                         'מפעיל פקודת תיקון בלולאה *מס' פסקאות
                                                            For P = 1 To Pcol2
                                                            'מקטין רווח אחרי פסקה
                                                          With Selection
                                                           For B = 1 To .Paragraphs.Count
                                                        .Paragraphs(B).Format.SpaceAfter = .Paragraphs(B).Format.SpaceAfter - PPS
                                                       Next B
                                                      End With
                                      
                                                     'עבור לפסקה הבאה
                                                      Selection.MoveDown wdParagraph, 1
                                                         Next P
                                      
                                                      'אחרת עובר עמוד
                                                          Else
                                                          'עבור לפסקה הבאה
                                                   Endcol2.Select
                                                     Selection.MoveDown wdParagraph, 1
                                                           End If
                                                           End If
                                                        End If
                                                         End If
                                        'אם טור 2 רב פסקאות או שווה
                                    ElseIf Pcol2 > Pcol1 Or Pcol2 = Pcol1 Then
                                    
                                            'עורך טור 2
                                    
                                                'מחלק הפרש בין פסקאות
                                        
                                                   PPS = Acol / Pcol2
                                               'עבור לשורה ראשונה בטור 2
                                                 Startcol2.Select
                                        
                                                'אם טור 1 ארוך מ2
                                                   If col1 > col2 Then
                                                          'בודק אם רווח לא גדול מ25
                                                          If SpaceAfter + PPS < 25 Then
                                          
                                                          'מפעיל פקודת תיקון בלולאה *מס' פסקאות
                                                           For P = 1 To Pcol2
                                      
                                                    'מוסיף רווח אחרי פסקה
                                                       With Selection
                                                      For B = 1 To .Paragraphs.Count
                                                       .Paragraphs(B).Format.SpaceAfter = .Paragraphs(B).Format.SpaceAfter + PPS
                                                        Next B
                                                      End With
                                     
                                      
                                                     'עבור לפסקה הבאה
                                                      Selection.MoveDown wdParagraph, 1
                                                           Next P
                                       
                                                     'אחרת עורך טור 1
                                                          Else
                                                       If Pcol1 = 0 Then
                                                        'אחרת עובר עמוד
                                                        
                                                     Endcol2.Select
                                                     Selection.MoveDown wdParagraph, 1
                                                     
                                                     Else
                                                        ' PPS - מחלק הפרש בין פסקאות
                                                           PPS = Acol / Pcol1
                                    
                                                        'עבור לשורה ראשונה בטור
                                                              Startcol1.Select
                                    
                                                          'בודק אם רווח לא קטן מ2.5
                                                          If SpaceAfter - PPS > 2.5 Then
                                        
                                                           'מפעיל פקודת תיקון בלולאה *מס' פסקאות
                                                        For P = 1 To Pcol1
                                     
                                                        'מקטין רווח אחרי פסקה
                                                             With Selection
                                                              For B = 1 To .Paragraphs.Count
                                          
                                                                .Paragraphs(B).Format.SpaceAfter = .Paragraphs(B).Format.SpaceAfter - PPS
                                                                Next B
                                                                    End With
                                        
                                           
                                                                  'עבור לפסקה הבאה
                                                              Selection.MoveDown wdParagraph, 1
                                                                  Next P
                                                         'אחרת עובר עמוד
                                                          Else
                                                          'עבור לפסקה הבאה
                                                         Endcol2.Select
                                                         Selection.MoveDown wdParagraph, 1
                                    
                                                           End If
                                                            End If
                                              End If
                                             
                                          
                                                     'אם טור 2 ארוך מ1
                                                      ElseIf col2 > col1 Then
                                                           'בודק אם רווח לא קטן מ2.5
                                                               If SpaceAfter - PPS > 2.5 Then
                                        
                                                             'מפעיל פקודת תיקון בלולאה *מס' פסקאות
                                                              For P = 1 To Pcol2
                                     
                                                                'מקטין רווח אחרי פסקה
                                                              With Selection
                                                               For B = 1 To .Paragraphs.Count
                                                               .Paragraphs(B).Format.SpaceAfter = .Paragraphs(B).Format.SpaceAfter - PPS
                                                               Next B
                                                              End With
                                      
                                      
                                                             'עבור לפסקה הבאה
                                                          Selection.MoveDown wdParagraph, 1
                                                              Next P
                                      
                                                              'אחרת עורך טור 1
                                                               Else
                                            
                                                       If Pcol1 = 0 Then
                                                        'אחרת עובר עמוד
                                                        
                                                     Endcol2.Select
                                                     Selection.MoveDown wdParagraph, 1
                                                     
                                                     Else
                                                                ' PPS - מחלק הפרש בין פסקאות
                                                                  PPS = Acol / Pcol1
                                    
                                                                     'עבור לשורה ראשונה בטור
                                                                      Startcol1.Select
                                      
                                                                     'בודק אם רווח לא  גדול מ25
                                                                        If SpaceAfter + PPS < 25 Then
                                                                         'מפעיל פקודת תיקון בלולאה *מס' פסקאות
                                                                          For P = 1 To Pcol1
                                     
                                                                        'מגדיל  רווח אחרי פסקה
                                                                         With Selection
                                                                          For B = 1 To .Paragraphs.Count
                                          
                                                                        .Paragraphs(B).Format.SpaceAfter = .Paragraphs(B).Format.SpaceAfter + PPS
                                                                           Next B
                                                                        End With
                                           
                                                                         'עבור לפסקה הבאה
                                                                          Selection.MoveDown wdParagraph, 1
                                                                           Next P
                                         
                                                                           'אחרת עובר עמוד
                                                                        Else
                                                                           'עבור לפסקה הבאה
                                                                             Endcol2.Select
                                                                             Selection.MoveDown wdParagraph, 1
                                     
                                                                          End If
                                                                         End If
                                                                          End If
                                                       End If
                                                 End If
                                           'עובר לעמודה הבאה
                                      Endcol2.Select
                                         Selection.MoveDown wdParagraph, 1
                                    
                                       
                                          End If
                                    
                                          'עובר לעמודה הבאה
                                      Endcol2.Select
                                         Selection.MoveDown wdParagraph, 1
                                    
                                       
                                       
                                       
                                       Application.ScreenUpdating = True
                                    End Sub
                                    
                                    
                                    

                                    ושאר הקודים בקובץ המצ"ב

                                    האדם החושבה M menajemmendelM 4 תגובות תגובה אחרונה
                                    9
                                    • ר רפרם ב"ר פפא

                                      בסייעתא דשמיא
                                      עדכון המאקרו יישור טורים - תוספות ותיקונים
                                      בהמשך להערות וההארות שנכתבו בשרשור זה בסייעתא דשמיא הנני להציע לציבור היקר את מאקרו יישור טורים גרסה 3
                                      א.סודר ענין השגיאה של מרווח פחות מ0
                                      וכמו כן נקבע שמרווח בין פסקאות לא יוכל לחרוג מטווח של 2.5 נקודות מינימום ו25 נקודת מקסימום (וזה לצורך הנראות הבסיסית) ונוסף גם שכשלא מצליח בטור הראשון (שהוא רב בפסקאות לעומת השני) מנסה בטור השני (ואם בשני טורים לא עומד בכללים אז ביישור מסמך שלם או מספר עמודים מדלג באופן אוטומטי לעמוד הבא וביישור עמוד אחד מודיע שלא עומד בכללים שהוצבו)
                                      ב. כמו כן מדלג על מסגרות ותיבות טקסט
                                      (ג. כמו כן מאחר שהוגדר מינימום 2.5 נקודות ממילא לא תהיה בעיה של עובי כתב בכותרת)
                                      ד. נוסף פקודה יישור ממיקום הסמן עד סוף כל המסמך (וטוב במקרה של באג וכו לדלג על המקום הבעייתי)
                                      ה. נוסף פקודה ליישור מכותרת על טור 1 עד כותרת הבאה (דהיינו סימן אחד בקונטרס)
                                      ו. ביישור כל המסמך במקרה שיש כותרת באמצע עמוד מיישר גם את החלק העליון וגם את התחתון
                                      בהצלחה
                                      ואשמח לשמוע אם עובד כמצופה וכן על באגים שלא יהיו וכן הצעות ייעול
                                      נראה שהוא דבר שיכול להועיל להרבה משתמשים ולחסוך זמן לכן אני מקווה לעשות כתוסף לכשיהיה מושלם
                                      וכן בכוונתי להוסיף אפשרות להגדיר את הטווח מינימום ומקסימום ועוד בל"נ
                                      הכל בעזרתו יתברך ובישועתו
                                      מצ"ב הקובץיישור טורים 3.dotm ועודכן בפוסט הראשי

                                      והקוד המתוקן והמשופץ
                                      ליישור עמוד אחד

                                      
                                      Dim WRange, Endcol2, Startcol1, Rcol1, Rcol2 As Range
                                      Dim NumLines, WPage, Pcol1, Pcol2, APcol, PPS, a, i, B, C, LM, P, S, V, col1, col2, Acol, Ignore As Double
                                      
                                      Public Sub יישור_טורים_עמוד_זה()
                                      
                                      'בודק אם יש שני טורים
                                      If Selection.PageSetup.TextColumns.Count <> 2 Then MsgBox ("לא נמצאו 2 טורים"): Exit Sub
                                      'עדכון מסך שקר
                                      Application.ScreenUpdating = False
                                      Dim WRange, Endcol2, Startcol1, Rcol1, Rcol2 As Range
                                      Dim NumLines, WPage, Pcol1, Pcol2, APcol, PPS, a, i, B, C, LM, P, S, V, col1, col2, Acol, Ignore As Double
                                      
                                      'שומר תחילת שורה של מיקום נוכחי
                                      Selection.HomeKey Unit:=wdLine
                                      Set My = Selection.Range
                                      
                                      'בחר את כל העמוד
                                      Set WRange = ActiveDocument.Bookmarks("\page").Range
                                      
                                      'עובר לתחילת עמוד
                                      WRange.SetRange Start:=WRange.Start, End:=WRange.Start + 1
                                      WRange.Select
                                      Set Startpage = Selection.Range
                                      WRange.SetRange Start:=Startpage.End, End:=My.End
                                      'סופר שורות
                                      WRange.Select
                                      SLines = Selection.Range.ComputeStatistics(wdStatisticLines)
                                      'חוזר ומפעיל לולאת בדיקה שאין כותרת'
                                      My.Select
                                      'Startcol1 מגדיר תחילת טור 1
                                        Set Startcol1 = Selection.Range
                                      For S = 1 To SLines - 1
                                          Selection.GoTo What:=wdGoToLine, Which:=wdGoToPrevious, Count:=1, Name:=""
                                           If Selection.PageSetup.TextColumns.Count <> 2 Then
                                              Exit For
                                          Else
                                              Set Startcol1 = Selection.Range
                                          End If
                                      Next
                                      'סוף עמוד
                                      Set WRange = ActiveDocument.Bookmarks("\page").Range
                                      WRange.SetRange Start:=WRange.End - 1, End:=WRange.End
                                      WRange.Select
                                      Set Endpage = Selection.Range
                                      WRange.SetRange Start:=My.Start, End:=Endpage.End
                                      'סופר שורות
                                      WRange.Select
                                      ELines = Selection.Range.ComputeStatistics(wdStatisticLines)
                                      My.Select
                                      'Endcol2 מגדיר סוף טור 2
                                      Set Endcol2 = Selection.Range
                                      For S = 1 To ELines - 1
                                          Selection.GoTo What:=wdGoToLine, Which:=wdGoToNext, Count:=1, Name:=""
                                           If Selection.PageSetup.TextColumns.Count <> 2 Then
                                              Exit For
                                          Else
                                              Set Endcol2 = Selection.Range
                                          End If
                                      Next
                                      
                                      'מספר שורות כולל שני טורים
                                      Set WRange = Selection.Range
                                      WRange.SetRange Start:=Startcol1.End, End:=Endcol2.End
                                      WRange.Select
                                      NumLines = Selection.Range.ComputeStatistics(wdStatisticLines)
                                      ' - col2 מגדיר גובה טור 2
                                      Endcol2.Select
                                      col2 = Endcol2.Information(wdVerticalPositionRelativeToPage)
                                      Selection.EndKey Unit:=wdLine
                                      Set Endcol2 = Selection.Range
                                      
                                      
                                      '  col1מגדיר גובה טור =1
                                      'Endcol1= סוף טור 1
                                      'Startcol2= תחילת טור2
                                      
                                      Startcol1.Select
                                      For i = 1 To NumLines
                                          Selection.GoTo What:=wdGoToLine, Which:=wdGoToNext, Count:=1, Name:=""
                                         If col1 > Selection.Information(wdVerticalPositionRelativeToPage) Then
                                        Set Startcol2 = Selection.Range
                                              Exit For
                                          Else
                                              col1 = Selection.Information(wdVerticalPositionRelativeToPage)
                                             Set Endcol1 = Selection.Range
                                          End If
                                          
                                      Next
                                      'סוף טור 1 = סוף שורה
                                      Endcol1.Select
                                      Selection.EndKey Unit:=wdLine
                                      Set Endcol1 = Selection.Range
                                      
                                      'Acol= מגדיר הפרש בין טורים
                                              If col1 > col2 Then Acol = col1 - col2
                                              If col1 < col2 Then Acol = col2 - col1
                                          
                                          'בודק אם טורים ישרים
                                      
                                        If Acol < 0.05 Then
                                          MsgBox "טורים ישרים"
                                       'אם רווח גדול מידי מוסיף בסוף פסקה מעבר מקטע בטור 1
                                         ElseIf Acol > 30 Then
                                         Endcol2.Select
                                       ActiveDocument.Range(Start:=Selection.Start, End:=Selection.Start). _
                                              InsertBreak Type:=wdSectionBreakContinuous
                                          Selection.Start = Selection.Start + 1
                                      ActiveDocument.Range(Start:=Selection.End, End:=Selection.End).InsertBreak _
                                               Type:=wdSectionBreakContinuous
                                          With Selection.PageSetup.TextColumns
                                              .SetCount NumColumns:=1
                                              .EvenlySpaced = True
                                              .LineBetween = False
                                          End With
                                          
                                         Else
                                          
                                      'Pcol1 = מספר פסקאות טור 1
                                          WRange.SetRange Start:=Startcol1.Start, End:=Endcol1.End - 2
                                          WRange.Select
                                         Set Rcol1 = Selection.Range
                                           Rcol1.Select
                                        Pcol1 = (Rcol1.ComputeStatistics(wdStatisticParagraphs))
                                      
                                      'Pcol2 = מספר פסקאות טור 2
                                          WRange.SetRange Start:=Startcol2.Start, End:=Endcol2.End - 2
                                          WRange.Select
                                          Set Rcol2 = Selection.Range
                                           Rcol2.Select
                                         Pcol2 = (Rcol2.ComputeStatistics(wdStatisticParagraphs))
                                      'טור מרובה פסקאות
                                      If Pcol1 > Pcol2 Then
                                      
                                              'עורך טור1
                                        
                                              ' PPS - מחלק הפרש בין פסקאות
                                                  PPS = Acol / Pcol1
                                      
                                                   'עבור לשורה ראשונה בטור
                                                        Startcol1.Select
                                          
                                                      ' 'אם טור 1 ארוך מ2
                                                      If col1 > col2 Then
                                                        'בודק אם רווח לא קטן מ2.5
                                                        If SpaceAfter - PPS > 2.5 Then
                                                       'מפעיל פקודת תיקון בלולאה *מס' פסקאות
                                                          For P = 1 To Pcol1
                                       
                                                  'מקטין רווח אחרי פסקה
                                                     With Selection
                                                             For B = 1 To .Paragraphs.Count
                                            
                                                        .Paragraphs(B).Format.SpaceAfter = .Paragraphs(B).Format.SpaceAfter - PPS
                                                         Next B
                                                       End With
                                              
                                                   'עבור לפסקה הבאה
                                                    Selection.MoveDown wdParagraph, 1
                                                    Next P
                                                      'אחרת עורך טור 2
                                                         Else
                                                         If Pcol2 = 0 Then
                                                          'אחרת עובר עמוד
                                                          
                                                       Endcol2.Select
                                                       Selection.MoveDown wdParagraph, 1
                                                       MsgBox ("לא עומד בקרטיונים שנקבעו נא נסה לערוך ידנית")
                                                       Else
                                                            PPS = Acol / Pcol2
                                                         'עבור לשורה ראשונה בטור 2
                                                          Startcol2.Select
                                        
                                                           'בודק אם רווח לא גדול מ25
                                      
                                                          If SpaceAfter + PPS < 25 Then
                                                         'מפעיל פקודת תיקון בלולאה *מס' פסקאות
                                                          For P = 1 To Pcol2
                                                      'מוסיף רווח אחרי פסקה
                                                         With Selection
                                                         For B = 1 To .Paragraphs.Count
                                                          .Paragraphs(B).Format.SpaceAfter = .Paragraphs(B).Format.SpaceAfter + PPS
                                                          Next B
                                                        End With
                                      
                                                       'עבור לפסקה הבאה
                                                        Selection.MoveDown wdParagraph, 1
                                                        Next P
                                         
                                                            'אחרת עובר עמוד
                                                          Else
                                                         'עבור לפסקה הבאה
                                                       Endcol2.Select
                                                       Selection.MoveDown wdParagraph, 1
                                                       MsgBox ("לא עומד בקרטיונים שנקבעו נא נסה לערוך ידנית")
                                                        End If
                                                         End If
                                                End If
                                          
                                                   'אם טור 2 ארוך מ1
                                                   ElseIf col1 < col2 Then
                                            
                                                          'בודק אם רווח לא גדול מ25
                                                           If SpaceAfter + PPS < 25 Then
                                                           'מפעיל פקודת תיקון בלולאה *מס' פסקאות
                                                          For P = 1 To Pcol1
                                                          'מוסיף רווח אחרי פסקה
                                                            With Selection
                                                            For B = 1 To .Paragraphs.Count
                                                              .Paragraphs(B).Format.SpaceAfter = .Paragraphs(B).Format.SpaceAfter + PPS
                                                           Next B
                                                            End With
                                           
                                                           'עבור לפסקה הבאה
                                                             Selection.MoveDown wdParagraph, 1
                                                          Next P
                                           
                                                          'אחרת שרווח יהיה גדול מ25 עורך טור 2
                                                           Else
                                                            If Pcol2 = 0 Then
                                                          'אחרת עובר עמוד
                                                          
                                                       Endcol2.Select
                                                       Selection.MoveDown wdParagraph, 1
                                                       MsgBox ("לא עומד בקרטיונים שנקבעו נא נסה לערוך ידנית")
                                                       Else
                                                            PPS = Acol / Pcol2
                                                             'עבור לשורה ראשונה בטור 2
                                                                 Startcol2.Select
                                        
                                                               'בודק אם רווח לא קטן מ2.5
                                                               If SpaceAfter - PPS > 2.5 Then
                                          
                                                           'מפעיל פקודת תיקון בלולאה *מס' פסקאות
                                                              For P = 1 To Pcol2
                                                              'מקטין רווח אחרי פסקה
                                                            With Selection
                                                             For B = 1 To .Paragraphs.Count
                                                          .Paragraphs(B).Format.SpaceAfter = .Paragraphs(B).Format.SpaceAfter - PPS
                                                         Next B
                                                        End With
                                        
                                                       'עבור לפסקה הבאה
                                                        Selection.MoveDown wdParagraph, 1
                                                           Next P
                                        
                                                        'אחרת עובר עמוד
                                                            Else
                                                            'עבור לפסקה הבאה
                                                     Endcol2.Select
                                                       Selection.MoveDown wdParagraph, 1
                                                       MsgBox ("לא עומד בקרטיונים שנקבעו נא נסה לערוך ידנית")
                                                             End If
                                                             End If
                                                          End If
                                                           End If
                                          'אם טור 2 רב פסקאות או שווה
                                      ElseIf Pcol2 > Pcol1 Or Pcol2 = Pcol1 Then
                                      
                                              'עורך טור 2
                                      
                                                  'מחלק הפרש בין פסקאות
                                          
                                                     PPS = Acol / Pcol2
                                                 'עבור לשורה ראשונה בטור 2
                                                   Startcol2.Select
                                          
                                                  'אם טור 1 ארוך מ2
                                                     If col1 > col2 Then
                                                            'בודק אם רווח לא גדול מ25
                                                            If SpaceAfter + PPS < 25 Then
                                            
                                                            'מפעיל פקודת תיקון בלולאה *מס' פסקאות
                                                             For P = 1 To Pcol2
                                        
                                                      'מוסיף רווח אחרי פסקה
                                                         With Selection
                                                        For B = 1 To .Paragraphs.Count
                                                         .Paragraphs(B).Format.SpaceAfter = .Paragraphs(B).Format.SpaceAfter + PPS
                                                          Next B
                                                        End With
                                       
                                        
                                                       'עבור לפסקה הבאה
                                                        Selection.MoveDown wdParagraph, 1
                                                             Next P
                                         
                                                       'אחרת עורך טור 1
                                                            Else
                                                         If Pcol1 = 0 Then
                                                          'אחרת עובר עמוד
                                                          
                                                       Endcol2.Select
                                                       Selection.MoveDown wdParagraph, 1
                                                       MsgBox ("לא עומד בקרטיונים שנקבעו נא נסה לערוך ידנית")
                                                       Else
                                                          ' PPS - מחלק הפרש בין פסקאות
                                                             PPS = Acol / Pcol1
                                      
                                                          'עבור לשורה ראשונה בטור
                                                                Startcol1.Select
                                      
                                                            'בודק אם רווח לא קטן מ2.5
                                                            If SpaceAfter - PPS > 2.5 Then
                                          
                                                             'מפעיל פקודת תיקון בלולאה *מס' פסקאות
                                                          For P = 1 To Pcol1
                                       
                                                          'מקטין רווח אחרי פסקה
                                                               With Selection
                                                                For B = 1 To .Paragraphs.Count
                                            
                                                                  .Paragraphs(B).Format.SpaceAfter = .Paragraphs(B).Format.SpaceAfter - PPS
                                                                  Next B
                                                                      End With
                                          
                                             
                                                                    'עבור לפסקה הבאה
                                                                Selection.MoveDown wdParagraph, 1
                                                                    Next P
                                                           'אחרת עובר עמוד
                                                            Else
                                                            'עבור לפסקה הבאה
                                                           Endcol2.Select
                                                           Selection.MoveDown wdParagraph, 1
                                                              MsgBox ("לא עומד בקרטיונים שנקבעו נא נסה לערוך ידנית")
                                                             End If
                                                              End If
                                                End If
                                               
                                            
                                                       'אם טור 2 ארוך מ1
                                                        ElseIf col2 > col1 Then
                                                             'בודק אם רווח לא קטן מ2.5
                                                                 If SpaceAfter - PPS > 2.5 Then
                                          
                                                               'מפעיל פקודת תיקון בלולאה *מס' פסקאות
                                                                For P = 1 To Pcol2
                                       
                                                                  'מקטין רווח אחרי פסקה
                                                                With Selection
                                                                 For B = 1 To .Paragraphs.Count
                                                                 .Paragraphs(B).Format.SpaceAfter = .Paragraphs(B).Format.SpaceAfter - PPS
                                                                 Next B
                                                                End With
                                        
                                        
                                                               'עבור לפסקה הבאה
                                                            Selection.MoveDown wdParagraph, 1
                                                                Next P
                                        
                                                                'אחרת עורך טור 1
                                                                 Else
                                              
                                                         If Pcol1 = 0 Then
                                                          'אחרת עובר עמוד
                                                          
                                                       Endcol2.Select
                                                       Selection.MoveDown wdParagraph, 1
                                                       MsgBox ("לא עומד בקרטיונים שנקבעו נא נסה לערוך ידנית")
                                                       Else
                                                                  ' PPS - מחלק הפרש בין פסקאות
                                                                    PPS = Acol / Pcol1
                                      
                                                                       'עבור לשורה ראשונה בטור
                                                                        Startcol1.Select
                                        
                                                                       'בודק אם רווח לא  גדול מ25
                                                                          If SpaceAfter + PPS < 25 Then
                                                                           'מפעיל פקודת תיקון בלולאה *מס' פסקאות
                                                                            For P = 1 To Pcol1
                                       
                                                                          'מגדיל  רווח אחרי פסקה
                                                                           With Selection
                                                                            For B = 1 To .Paragraphs.Count
                                            
                                                                          .Paragraphs(B).Format.SpaceAfter = .Paragraphs(B).Format.SpaceAfter + PPS
                                                                             Next B
                                                                          End With
                                             
                                                                           'עבור לפסקה הבאה
                                                                            Selection.MoveDown wdParagraph, 1
                                                                             Next P
                                           
                                                                             'אחרת עובר עמוד
                                                                          Else
                                                                             'עבור לפסקה הבאה
                                                                               Endcol2.Select
                                                                               Selection.MoveDown wdParagraph, 1
                                                                              MsgBox ("לא עומד בקרטיונים שנקבעו נא נסה לערוך ידנית")
                                                                            End If
                                                                           End If
                                                                            End If
                                                         End If
                                                   End If
                                            End If
                                            
                                      
                                         My.Select
                                         
                                         Application.ScreenUpdating = True
                                      End Sub
                                      
                                      
                                      
                                      

                                      ליישור כל המסמך

                                      Dim WRange, Endcol1, Startcol1, Endcol2, Startcol2, Rcol1, Rcol2 As Range
                                      Dim NumLines, WPage, Pcol1, Pcol2, APcol, PPS, a, i, B, C, P, R, S, G, col1, col2, Acol, Ignore As Double
                                      
                                      Public Sub יישור_טורים_בכל_המסמך_חדש()
                                      'עדכון מסך שקר
                                      Application.ScreenUpdating = False
                                      'מספר פסקאות
                                      
                                      
                                      'תחילה בסוף מסמך מוסיף תו כטור 1
                                      Selection.WholeStory
                                      Set Whole = Selection.Range
                                      Whole.SetRange Start:=Whole.End, End:=Whole.End
                                      Whole.Select
                                      If Selection.PageSetup.TextColumns.Count = 2 Then
                                       ActiveDocument.Range(Start:=Selection.Start, End:=Selection.Start). _
                                              InsertBreak Type:=wdSectionBreakContinuous
                                          Selection.Start = Selection.Start + 1
                                      ActiveDocument.Range(Start:=Selection.End, End:=Selection.End).InsertBreak _
                                               Type:=wdSectionBreakContinuous
                                          With Selection.PageSetup.TextColumns
                                              .SetCount NumColumns:=1
                                              .EvenlySpaced = True
                                              .LineBetween = False
                                          End With
                                              Else
                                          End If
                                          'עובר לפסקה ראשונה
                                          ActiveDocument.Paragraphs(1).Range.Select
                                          'נכנס לללואה על כל המסמך
                                          For R = 1 To ActiveDocument.Paragraphs.Count / 3
                                      'בודק אם יש שני טורים
                                      If Selection.PageSetup.TextColumns.Count = 2 Then
                                             Application.Run MacroName:="עורך_טורים"
                                              Else
                                          Selection.MoveDown wdParagraph, 1
                                          End If
                                          
                                            Next R
                                           
                                         Application.ScreenUpdating = True
                                      End Sub
                                      
                                      Public Sub עורך_טורים()
                                      'עדכון מסך שקר
                                      Application.ScreenUpdating = False
                                      Dim WRange, Endcol2, Startcol1, Rcol1, Rcol2 As Range
                                      Dim NumLines, WPage, Pcol1, Pcol2, APcol, PPS, LM, a, i, B, C, P, S, col1, col2, Acol, Ignore As Double
                                      
                                      'שומר תחילת שורה של מיקום נוכחי
                                      Selection.HomeKey Unit:=wdLine
                                      Set My = Selection.Range
                                      
                                      'בחר את כל העמוד
                                      Set WRange = ActiveDocument.Bookmarks("\page").Range
                                      
                                      'עובר לתחילת עמוד
                                      WRange.SetRange Start:=WRange.Start, End:=WRange.Start + 1
                                      WRange.Select
                                      Set Startpage = Selection.Range
                                      WRange.SetRange Start:=Startpage.End, End:=My.End
                                      'סופר שורות
                                      WRange.Select
                                      SLines = Selection.Range.ComputeStatistics(wdStatisticLines)
                                      'חוזר ומפעיל לולאת בדיקה שאין כותרת'
                                      My.Select
                                      'Startcol1 מגדיר תחילת טור 1
                                      Set Startcol1 = Selection.Range
                                      For S = 1 To SLines - 1
                                          Selection.GoTo What:=wdGoToLine, Which:=wdGoToPrevious, Count:=1, Name:=""
                                           If Selection.PageSetup.TextColumns.Count <> 2 Then
                                              Exit For
                                          Else
                                              Set Startcol1 = Selection.Range
                                          End If
                                      Next
                                      'סוף עמוד
                                      Set WRange = ActiveDocument.Bookmarks("\page").Range
                                      WRange.SetRange Start:=WRange.End - 1, End:=WRange.End
                                      WRange.Select
                                      Set Endpage = Selection.Range
                                      WRange.SetRange Start:=My.Start, End:=Endpage.End
                                      'סופר שורות
                                      WRange.Select
                                      ELines = Selection.Range.ComputeStatistics(wdStatisticLines)
                                      My.Select
                                      'Endcol2מגדיר סוף טור 2
                                      Set Endcol2 = Selection.Range
                                      For S = 1 To ELines - 1
                                          Selection.GoTo What:=wdGoToLine, Which:=wdGoToNext, Count:=1, Name:=""
                                           If Selection.PageSetup.TextColumns.Count <> 2 Then
                                              Exit For
                                          Else
                                              Set Endcol2 = Selection.Range
                                          End If
                                      Next
                                      
                                      'מספר שורות כולל שני טורים
                                      Set WRange = Selection.Range
                                      WRange.SetRange Start:=Startcol1.End, End:=Endcol2.End
                                      WRange.Select
                                      NumLines = Selection.Range.ComputeStatistics(wdStatisticLines)
                                      ' - col2 מגדיר גובה טור 2
                                      Endcol2.Select
                                      col2 = Endcol2.Information(wdVerticalPositionRelativeToPage)
                                      Selection.EndKey Unit:=wdLine
                                      Set Endcol2 = Selection.Range
                                      
                                      
                                      '  col1מגדיר גובה טור -1
                                      'Endcol1- סוף טור 1
                                      'Startcol2- תחילת טור2
                                      
                                      Startcol1.Select
                                      For i = 1 To NumLines
                                          Selection.GoTo What:=wdGoToLine, Which:=wdGoToNext, Count:=1, Name:=""
                                         If col1 > Selection.Information(wdVerticalPositionRelativeToPage) Then
                                        Set Startcol2 = Selection.Range
                                              Exit For
                                          Else
                                              col1 = Selection.Information(wdVerticalPositionRelativeToPage)
                                             Set Endcol1 = Selection.Range
                                          End If
                                          
                                      Next
                                      'סוף טור 1 = סוף שורה
                                      Endcol1.Select
                                      Selection.EndKey Unit:=wdLine
                                      Set Endcol1 = Selection.Range
                                      
                                      'Acol מגדיר הפרש בין טורים
                                              If col1 > col2 Then Acol = col1 - col2
                                              If col1 < col2 Then Acol = col2 - col1
                                          
                                          'בודק אם טורים ישרים
                                      
                                        If Acol < 0.05 Then
                                        'עובר לעמודה הבאה
                                        Endcol2.Select
                                           Selection.MoveDown wdParagraph, 1
                                            
                                         Else
                                          
                                      'Pcol1 - מספר פסקאות טור 1
                                          WRange.SetRange Start:=Startcol1.Start, End:=Endcol1.End - 2
                                          WRange.Select
                                         Set Rcol1 = Selection.Range
                                           Rcol1.Select
                                        Pcol1 = (Rcol1.ComputeStatistics(wdStatisticParagraphs))
                                      
                                      'Pcol2 - מספר פסקאות טור 2
                                          WRange.SetRange Start:=Startcol2.Start, End:=Endcol2.End - 2
                                          WRange.Select
                                          Set Rcol2 = Selection.Range
                                           Rcol2.Select
                                         Pcol2 = (Rcol2.ComputeStatistics(wdStatisticParagraphs))
                                      
                                      If Pcol1 > Pcol2 Then
                                      
                                              'עורך טור1
                                        
                                              ' PPS - מחלק הפרש בין פסקאות
                                                  PPS = Acol / Pcol1
                                      
                                                   'עבור לשורה ראשונה בטור
                                                        Startcol1.Select
                                          
                                                      ' 'אם טור 1 ארוך מ2
                                                      If col1 > col2 Then
                                                        'בודק אם רווח לא קטן מ2.5
                                                        If SpaceAfter - PPS > 2.5 Then
                                                       'מפעיל פקודת תיקון בלולאה *מס' פסקאות
                                                          For P = 1 To Pcol1
                                       
                                                  'מקטין רווח אחרי פסקה
                                                     With Selection
                                                             For B = 1 To .Paragraphs.Count
                                            
                                                        .Paragraphs(B).Format.SpaceAfter = .Paragraphs(B).Format.SpaceAfter - PPS
                                                         Next B
                                                       End With
                                              
                                                   'עבור לפסקה הבאה
                                                    Selection.MoveDown wdParagraph, 1
                                                    Next P
                                                      'אחרת עורך טור 2
                                                         Else
                                                         If Pcol2 = 0 Then
                                                          'אחרת עובר עמוד
                                                          
                                                       Endcol2.Select
                                                       Selection.MoveDown wdParagraph, 1
                                                       
                                                       Else
                                                            PPS = Acol / Pcol2
                                                         'עבור לשורה ראשונה בטור 2
                                                          Startcol2.Select
                                        
                                                           'בודק אם רווח לא גדול מ25
                                      
                                                          If SpaceAfter + PPS < 25 Then
                                                         'מפעיל פקודת תיקון בלולאה *מס' פסקאות
                                                          For P = 1 To Pcol2
                                                      'מוסיף רווח אחרי פסקה
                                                         With Selection
                                                         For B = 1 To .Paragraphs.Count
                                                          .Paragraphs(B).Format.SpaceAfter = .Paragraphs(B).Format.SpaceAfter + PPS
                                                          Next B
                                                        End With
                                      
                                                       'עבור לפסקה הבאה
                                                        Selection.MoveDown wdParagraph, 1
                                                        Next P
                                         
                                                            'אחרת עובר עמוד
                                                          Else
                                                         'עבור לפסקה הבאה
                                                       Endcol2.Select
                                                       Selection.MoveDown wdParagraph, 1
                                                        End If
                                                         End If
                                                End If
                                          
                                                   'אם טור 2 ארוך מ1
                                                   ElseIf col1 < col2 Then
                                            
                                                          'בודק אם רווח לא גדול מ25
                                                           If SpaceAfter + PPS < 25 Then
                                                           'מפעיל פקודת תיקון בלולאה *מס' פסקאות
                                                          For P = 1 To Pcol1
                                                          'מוסיף רווח אחרי פסקה
                                                            With Selection
                                                            For B = 1 To .Paragraphs.Count
                                                              .Paragraphs(B).Format.SpaceAfter = .Paragraphs(B).Format.SpaceAfter + PPS
                                                           Next B
                                                            End With
                                           
                                                           'עבור לפסקה הבאה
                                                             Selection.MoveDown wdParagraph, 1
                                                          Next P
                                           
                                                          'אחרת שרווח יהיה גדול מ25 עורך טור 2
                                                           Else
                                                            If Pcol2 = 0 Then
                                                          'אחרת עובר עמוד
                                                          
                                                       Endcol2.Select
                                                       Selection.MoveDown wdParagraph, 1
                                                       
                                                       Else
                                                            PPS = Acol / Pcol2
                                                             'עבור לשורה ראשונה בטור 2
                                                                 Startcol2.Select
                                        
                                                               'בודק אם רווח לא קטן מ2.5
                                                               If SpaceAfter - PPS > 2.5 Then
                                          
                                                           'מפעיל פקודת תיקון בלולאה *מס' פסקאות
                                                              For P = 1 To Pcol2
                                                              'מקטין רווח אחרי פסקה
                                                            With Selection
                                                             For B = 1 To .Paragraphs.Count
                                                          .Paragraphs(B).Format.SpaceAfter = .Paragraphs(B).Format.SpaceAfter - PPS
                                                         Next B
                                                        End With
                                        
                                                       'עבור לפסקה הבאה
                                                        Selection.MoveDown wdParagraph, 1
                                                           Next P
                                        
                                                        'אחרת עובר עמוד
                                                            Else
                                                            'עבור לפסקה הבאה
                                                     Endcol2.Select
                                                       Selection.MoveDown wdParagraph, 1
                                                             End If
                                                             End If
                                                          End If
                                                           End If
                                          'אם טור 2 רב פסקאות או שווה
                                      ElseIf Pcol2 > Pcol1 Or Pcol2 = Pcol1 Then
                                      
                                              'עורך טור 2
                                      
                                                  'מחלק הפרש בין פסקאות
                                          
                                                     PPS = Acol / Pcol2
                                                 'עבור לשורה ראשונה בטור 2
                                                   Startcol2.Select
                                          
                                                  'אם טור 1 ארוך מ2
                                                     If col1 > col2 Then
                                                            'בודק אם רווח לא גדול מ25
                                                            If SpaceAfter + PPS < 25 Then
                                            
                                                            'מפעיל פקודת תיקון בלולאה *מס' פסקאות
                                                             For P = 1 To Pcol2
                                        
                                                      'מוסיף רווח אחרי פסקה
                                                         With Selection
                                                        For B = 1 To .Paragraphs.Count
                                                         .Paragraphs(B).Format.SpaceAfter = .Paragraphs(B).Format.SpaceAfter + PPS
                                                          Next B
                                                        End With
                                       
                                        
                                                       'עבור לפסקה הבאה
                                                        Selection.MoveDown wdParagraph, 1
                                                             Next P
                                         
                                                       'אחרת עורך טור 1
                                                            Else
                                                         If Pcol1 = 0 Then
                                                          'אחרת עובר עמוד
                                                          
                                                       Endcol2.Select
                                                       Selection.MoveDown wdParagraph, 1
                                                       
                                                       Else
                                                          ' PPS - מחלק הפרש בין פסקאות
                                                             PPS = Acol / Pcol1
                                      
                                                          'עבור לשורה ראשונה בטור
                                                                Startcol1.Select
                                      
                                                            'בודק אם רווח לא קטן מ2.5
                                                            If SpaceAfter - PPS > 2.5 Then
                                          
                                                             'מפעיל פקודת תיקון בלולאה *מס' פסקאות
                                                          For P = 1 To Pcol1
                                       
                                                          'מקטין רווח אחרי פסקה
                                                               With Selection
                                                                For B = 1 To .Paragraphs.Count
                                            
                                                                  .Paragraphs(B).Format.SpaceAfter = .Paragraphs(B).Format.SpaceAfter - PPS
                                                                  Next B
                                                                      End With
                                          
                                             
                                                                    'עבור לפסקה הבאה
                                                                Selection.MoveDown wdParagraph, 1
                                                                    Next P
                                                           'אחרת עובר עמוד
                                                            Else
                                                            'עבור לפסקה הבאה
                                                           Endcol2.Select
                                                           Selection.MoveDown wdParagraph, 1
                                      
                                                             End If
                                                              End If
                                                End If
                                               
                                            
                                                       'אם טור 2 ארוך מ1
                                                        ElseIf col2 > col1 Then
                                                             'בודק אם רווח לא קטן מ2.5
                                                                 If SpaceAfter - PPS > 2.5 Then
                                          
                                                               'מפעיל פקודת תיקון בלולאה *מס' פסקאות
                                                                For P = 1 To Pcol2
                                       
                                                                  'מקטין רווח אחרי פסקה
                                                                With Selection
                                                                 For B = 1 To .Paragraphs.Count
                                                                 .Paragraphs(B).Format.SpaceAfter = .Paragraphs(B).Format.SpaceAfter - PPS
                                                                 Next B
                                                                End With
                                        
                                        
                                                               'עבור לפסקה הבאה
                                                            Selection.MoveDown wdParagraph, 1
                                                                Next P
                                        
                                                                'אחרת עורך טור 1
                                                                 Else
                                              
                                                         If Pcol1 = 0 Then
                                                          'אחרת עובר עמוד
                                                          
                                                       Endcol2.Select
                                                       Selection.MoveDown wdParagraph, 1
                                                       
                                                       Else
                                                                  ' PPS - מחלק הפרש בין פסקאות
                                                                    PPS = Acol / Pcol1
                                      
                                                                       'עבור לשורה ראשונה בטור
                                                                        Startcol1.Select
                                        
                                                                       'בודק אם רווח לא  גדול מ25
                                                                          If SpaceAfter + PPS < 25 Then
                                                                           'מפעיל פקודת תיקון בלולאה *מס' פסקאות
                                                                            For P = 1 To Pcol1
                                       
                                                                          'מגדיל  רווח אחרי פסקה
                                                                           With Selection
                                                                            For B = 1 To .Paragraphs.Count
                                            
                                                                          .Paragraphs(B).Format.SpaceAfter = .Paragraphs(B).Format.SpaceAfter + PPS
                                                                             Next B
                                                                          End With
                                             
                                                                           'עבור לפסקה הבאה
                                                                            Selection.MoveDown wdParagraph, 1
                                                                             Next P
                                           
                                                                             'אחרת עובר עמוד
                                                                          Else
                                                                             'עבור לפסקה הבאה
                                                                               Endcol2.Select
                                                                               Selection.MoveDown wdParagraph, 1
                                       
                                                                            End If
                                                                           End If
                                                                            End If
                                                         End If
                                                   End If
                                             'עובר לעמודה הבאה
                                        Endcol2.Select
                                           Selection.MoveDown wdParagraph, 1
                                      
                                         
                                            End If
                                      
                                            'עובר לעמודה הבאה
                                        Endcol2.Select
                                           Selection.MoveDown wdParagraph, 1
                                      
                                         
                                         
                                         
                                         Application.ScreenUpdating = True
                                      End Sub
                                      
                                      
                                      

                                      ושאר הקודים בקובץ המצ"ב

                                      האדם החושבה מנותק
                                      האדם החושבה מנותק
                                      האדם החושב
                                      מדריכים
                                      כתב ב נערך לאחרונה על ידי
                                      #35

                                      @רפרם-ב-ר-פפא לא הבנתי האם הקודים שהבאת בסוף הפוסט או לא

                                      ר תגובה 1 תגובה אחרונה
                                      0
                                      • ר רפרם ב"ר פפא

                                        בסייעתא דשמיא
                                        עדכון המאקרו יישור טורים - תוספות ותיקונים
                                        בהמשך להערות וההארות שנכתבו בשרשור זה בסייעתא דשמיא הנני להציע לציבור היקר את מאקרו יישור טורים גרסה 3
                                        א.סודר ענין השגיאה של מרווח פחות מ0
                                        וכמו כן נקבע שמרווח בין פסקאות לא יוכל לחרוג מטווח של 2.5 נקודות מינימום ו25 נקודת מקסימום (וזה לצורך הנראות הבסיסית) ונוסף גם שכשלא מצליח בטור הראשון (שהוא רב בפסקאות לעומת השני) מנסה בטור השני (ואם בשני טורים לא עומד בכללים אז ביישור מסמך שלם או מספר עמודים מדלג באופן אוטומטי לעמוד הבא וביישור עמוד אחד מודיע שלא עומד בכללים שהוצבו)
                                        ב. כמו כן מדלג על מסגרות ותיבות טקסט
                                        (ג. כמו כן מאחר שהוגדר מינימום 2.5 נקודות ממילא לא תהיה בעיה של עובי כתב בכותרת)
                                        ד. נוסף פקודה יישור ממיקום הסמן עד סוף כל המסמך (וטוב במקרה של באג וכו לדלג על המקום הבעייתי)
                                        ה. נוסף פקודה ליישור מכותרת על טור 1 עד כותרת הבאה (דהיינו סימן אחד בקונטרס)
                                        ו. ביישור כל המסמך במקרה שיש כותרת באמצע עמוד מיישר גם את החלק העליון וגם את התחתון
                                        בהצלחה
                                        ואשמח לשמוע אם עובד כמצופה וכן על באגים שלא יהיו וכן הצעות ייעול
                                        נראה שהוא דבר שיכול להועיל להרבה משתמשים ולחסוך זמן לכן אני מקווה לעשות כתוסף לכשיהיה מושלם
                                        וכן בכוונתי להוסיף אפשרות להגדיר את הטווח מינימום ומקסימום ועוד בל"נ
                                        הכל בעזרתו יתברך ובישועתו
                                        מצ"ב הקובץיישור טורים 3.dotm ועודכן בפוסט הראשי

                                        והקוד המתוקן והמשופץ
                                        ליישור עמוד אחד

                                        
                                        Dim WRange, Endcol2, Startcol1, Rcol1, Rcol2 As Range
                                        Dim NumLines, WPage, Pcol1, Pcol2, APcol, PPS, a, i, B, C, LM, P, S, V, col1, col2, Acol, Ignore As Double
                                        
                                        Public Sub יישור_טורים_עמוד_זה()
                                        
                                        'בודק אם יש שני טורים
                                        If Selection.PageSetup.TextColumns.Count <> 2 Then MsgBox ("לא נמצאו 2 טורים"): Exit Sub
                                        'עדכון מסך שקר
                                        Application.ScreenUpdating = False
                                        Dim WRange, Endcol2, Startcol1, Rcol1, Rcol2 As Range
                                        Dim NumLines, WPage, Pcol1, Pcol2, APcol, PPS, a, i, B, C, LM, P, S, V, col1, col2, Acol, Ignore As Double
                                        
                                        'שומר תחילת שורה של מיקום נוכחי
                                        Selection.HomeKey Unit:=wdLine
                                        Set My = Selection.Range
                                        
                                        'בחר את כל העמוד
                                        Set WRange = ActiveDocument.Bookmarks("\page").Range
                                        
                                        'עובר לתחילת עמוד
                                        WRange.SetRange Start:=WRange.Start, End:=WRange.Start + 1
                                        WRange.Select
                                        Set Startpage = Selection.Range
                                        WRange.SetRange Start:=Startpage.End, End:=My.End
                                        'סופר שורות
                                        WRange.Select
                                        SLines = Selection.Range.ComputeStatistics(wdStatisticLines)
                                        'חוזר ומפעיל לולאת בדיקה שאין כותרת'
                                        My.Select
                                        'Startcol1 מגדיר תחילת טור 1
                                          Set Startcol1 = Selection.Range
                                        For S = 1 To SLines - 1
                                            Selection.GoTo What:=wdGoToLine, Which:=wdGoToPrevious, Count:=1, Name:=""
                                             If Selection.PageSetup.TextColumns.Count <> 2 Then
                                                Exit For
                                            Else
                                                Set Startcol1 = Selection.Range
                                            End If
                                        Next
                                        'סוף עמוד
                                        Set WRange = ActiveDocument.Bookmarks("\page").Range
                                        WRange.SetRange Start:=WRange.End - 1, End:=WRange.End
                                        WRange.Select
                                        Set Endpage = Selection.Range
                                        WRange.SetRange Start:=My.Start, End:=Endpage.End
                                        'סופר שורות
                                        WRange.Select
                                        ELines = Selection.Range.ComputeStatistics(wdStatisticLines)
                                        My.Select
                                        'Endcol2 מגדיר סוף טור 2
                                        Set Endcol2 = Selection.Range
                                        For S = 1 To ELines - 1
                                            Selection.GoTo What:=wdGoToLine, Which:=wdGoToNext, Count:=1, Name:=""
                                             If Selection.PageSetup.TextColumns.Count <> 2 Then
                                                Exit For
                                            Else
                                                Set Endcol2 = Selection.Range
                                            End If
                                        Next
                                        
                                        'מספר שורות כולל שני טורים
                                        Set WRange = Selection.Range
                                        WRange.SetRange Start:=Startcol1.End, End:=Endcol2.End
                                        WRange.Select
                                        NumLines = Selection.Range.ComputeStatistics(wdStatisticLines)
                                        ' - col2 מגדיר גובה טור 2
                                        Endcol2.Select
                                        col2 = Endcol2.Information(wdVerticalPositionRelativeToPage)
                                        Selection.EndKey Unit:=wdLine
                                        Set Endcol2 = Selection.Range
                                        
                                        
                                        '  col1מגדיר גובה טור =1
                                        'Endcol1= סוף טור 1
                                        'Startcol2= תחילת טור2
                                        
                                        Startcol1.Select
                                        For i = 1 To NumLines
                                            Selection.GoTo What:=wdGoToLine, Which:=wdGoToNext, Count:=1, Name:=""
                                           If col1 > Selection.Information(wdVerticalPositionRelativeToPage) Then
                                          Set Startcol2 = Selection.Range
                                                Exit For
                                            Else
                                                col1 = Selection.Information(wdVerticalPositionRelativeToPage)
                                               Set Endcol1 = Selection.Range
                                            End If
                                            
                                        Next
                                        'סוף טור 1 = סוף שורה
                                        Endcol1.Select
                                        Selection.EndKey Unit:=wdLine
                                        Set Endcol1 = Selection.Range
                                        
                                        'Acol= מגדיר הפרש בין טורים
                                                If col1 > col2 Then Acol = col1 - col2
                                                If col1 < col2 Then Acol = col2 - col1
                                            
                                            'בודק אם טורים ישרים
                                        
                                          If Acol < 0.05 Then
                                            MsgBox "טורים ישרים"
                                         'אם רווח גדול מידי מוסיף בסוף פסקה מעבר מקטע בטור 1
                                           ElseIf Acol > 30 Then
                                           Endcol2.Select
                                         ActiveDocument.Range(Start:=Selection.Start, End:=Selection.Start). _
                                                InsertBreak Type:=wdSectionBreakContinuous
                                            Selection.Start = Selection.Start + 1
                                        ActiveDocument.Range(Start:=Selection.End, End:=Selection.End).InsertBreak _
                                                 Type:=wdSectionBreakContinuous
                                            With Selection.PageSetup.TextColumns
                                                .SetCount NumColumns:=1
                                                .EvenlySpaced = True
                                                .LineBetween = False
                                            End With
                                            
                                           Else
                                            
                                        'Pcol1 = מספר פסקאות טור 1
                                            WRange.SetRange Start:=Startcol1.Start, End:=Endcol1.End - 2
                                            WRange.Select
                                           Set Rcol1 = Selection.Range
                                             Rcol1.Select
                                          Pcol1 = (Rcol1.ComputeStatistics(wdStatisticParagraphs))
                                        
                                        'Pcol2 = מספר פסקאות טור 2
                                            WRange.SetRange Start:=Startcol2.Start, End:=Endcol2.End - 2
                                            WRange.Select
                                            Set Rcol2 = Selection.Range
                                             Rcol2.Select
                                           Pcol2 = (Rcol2.ComputeStatistics(wdStatisticParagraphs))
                                        'טור מרובה פסקאות
                                        If Pcol1 > Pcol2 Then
                                        
                                                'עורך טור1
                                          
                                                ' PPS - מחלק הפרש בין פסקאות
                                                    PPS = Acol / Pcol1
                                        
                                                     'עבור לשורה ראשונה בטור
                                                          Startcol1.Select
                                            
                                                        ' 'אם טור 1 ארוך מ2
                                                        If col1 > col2 Then
                                                          'בודק אם רווח לא קטן מ2.5
                                                          If SpaceAfter - PPS > 2.5 Then
                                                         'מפעיל פקודת תיקון בלולאה *מס' פסקאות
                                                            For P = 1 To Pcol1
                                         
                                                    'מקטין רווח אחרי פסקה
                                                       With Selection
                                                               For B = 1 To .Paragraphs.Count
                                              
                                                          .Paragraphs(B).Format.SpaceAfter = .Paragraphs(B).Format.SpaceAfter - PPS
                                                           Next B
                                                         End With
                                                
                                                     'עבור לפסקה הבאה
                                                      Selection.MoveDown wdParagraph, 1
                                                      Next P
                                                        'אחרת עורך טור 2
                                                           Else
                                                           If Pcol2 = 0 Then
                                                            'אחרת עובר עמוד
                                                            
                                                         Endcol2.Select
                                                         Selection.MoveDown wdParagraph, 1
                                                         MsgBox ("לא עומד בקרטיונים שנקבעו נא נסה לערוך ידנית")
                                                         Else
                                                              PPS = Acol / Pcol2
                                                           'עבור לשורה ראשונה בטור 2
                                                            Startcol2.Select
                                          
                                                             'בודק אם רווח לא גדול מ25
                                        
                                                            If SpaceAfter + PPS < 25 Then
                                                           'מפעיל פקודת תיקון בלולאה *מס' פסקאות
                                                            For P = 1 To Pcol2
                                                        'מוסיף רווח אחרי פסקה
                                                           With Selection
                                                           For B = 1 To .Paragraphs.Count
                                                            .Paragraphs(B).Format.SpaceAfter = .Paragraphs(B).Format.SpaceAfter + PPS
                                                            Next B
                                                          End With
                                        
                                                         'עבור לפסקה הבאה
                                                          Selection.MoveDown wdParagraph, 1
                                                          Next P
                                           
                                                              'אחרת עובר עמוד
                                                            Else
                                                           'עבור לפסקה הבאה
                                                         Endcol2.Select
                                                         Selection.MoveDown wdParagraph, 1
                                                         MsgBox ("לא עומד בקרטיונים שנקבעו נא נסה לערוך ידנית")
                                                          End If
                                                           End If
                                                  End If
                                            
                                                     'אם טור 2 ארוך מ1
                                                     ElseIf col1 < col2 Then
                                              
                                                            'בודק אם רווח לא גדול מ25
                                                             If SpaceAfter + PPS < 25 Then
                                                             'מפעיל פקודת תיקון בלולאה *מס' פסקאות
                                                            For P = 1 To Pcol1
                                                            'מוסיף רווח אחרי פסקה
                                                              With Selection
                                                              For B = 1 To .Paragraphs.Count
                                                                .Paragraphs(B).Format.SpaceAfter = .Paragraphs(B).Format.SpaceAfter + PPS
                                                             Next B
                                                              End With
                                             
                                                             'עבור לפסקה הבאה
                                                               Selection.MoveDown wdParagraph, 1
                                                            Next P
                                             
                                                            'אחרת שרווח יהיה גדול מ25 עורך טור 2
                                                             Else
                                                              If Pcol2 = 0 Then
                                                            'אחרת עובר עמוד
                                                            
                                                         Endcol2.Select
                                                         Selection.MoveDown wdParagraph, 1
                                                         MsgBox ("לא עומד בקרטיונים שנקבעו נא נסה לערוך ידנית")
                                                         Else
                                                              PPS = Acol / Pcol2
                                                               'עבור לשורה ראשונה בטור 2
                                                                   Startcol2.Select
                                          
                                                                 'בודק אם רווח לא קטן מ2.5
                                                                 If SpaceAfter - PPS > 2.5 Then
                                            
                                                             'מפעיל פקודת תיקון בלולאה *מס' פסקאות
                                                                For P = 1 To Pcol2
                                                                'מקטין רווח אחרי פסקה
                                                              With Selection
                                                               For B = 1 To .Paragraphs.Count
                                                            .Paragraphs(B).Format.SpaceAfter = .Paragraphs(B).Format.SpaceAfter - PPS
                                                           Next B
                                                          End With
                                          
                                                         'עבור לפסקה הבאה
                                                          Selection.MoveDown wdParagraph, 1
                                                             Next P
                                          
                                                          'אחרת עובר עמוד
                                                              Else
                                                              'עבור לפסקה הבאה
                                                       Endcol2.Select
                                                         Selection.MoveDown wdParagraph, 1
                                                         MsgBox ("לא עומד בקרטיונים שנקבעו נא נסה לערוך ידנית")
                                                               End If
                                                               End If
                                                            End If
                                                             End If
                                            'אם טור 2 רב פסקאות או שווה
                                        ElseIf Pcol2 > Pcol1 Or Pcol2 = Pcol1 Then
                                        
                                                'עורך טור 2
                                        
                                                    'מחלק הפרש בין פסקאות
                                            
                                                       PPS = Acol / Pcol2
                                                   'עבור לשורה ראשונה בטור 2
                                                     Startcol2.Select
                                            
                                                    'אם טור 1 ארוך מ2
                                                       If col1 > col2 Then
                                                              'בודק אם רווח לא גדול מ25
                                                              If SpaceAfter + PPS < 25 Then
                                              
                                                              'מפעיל פקודת תיקון בלולאה *מס' פסקאות
                                                               For P = 1 To Pcol2
                                          
                                                        'מוסיף רווח אחרי פסקה
                                                           With Selection
                                                          For B = 1 To .Paragraphs.Count
                                                           .Paragraphs(B).Format.SpaceAfter = .Paragraphs(B).Format.SpaceAfter + PPS
                                                            Next B
                                                          End With
                                         
                                          
                                                         'עבור לפסקה הבאה
                                                          Selection.MoveDown wdParagraph, 1
                                                               Next P
                                           
                                                         'אחרת עורך טור 1
                                                              Else
                                                           If Pcol1 = 0 Then
                                                            'אחרת עובר עמוד
                                                            
                                                         Endcol2.Select
                                                         Selection.MoveDown wdParagraph, 1
                                                         MsgBox ("לא עומד בקרטיונים שנקבעו נא נסה לערוך ידנית")
                                                         Else
                                                            ' PPS - מחלק הפרש בין פסקאות
                                                               PPS = Acol / Pcol1
                                        
                                                            'עבור לשורה ראשונה בטור
                                                                  Startcol1.Select
                                        
                                                              'בודק אם רווח לא קטן מ2.5
                                                              If SpaceAfter - PPS > 2.5 Then
                                            
                                                               'מפעיל פקודת תיקון בלולאה *מס' פסקאות
                                                            For P = 1 To Pcol1
                                         
                                                            'מקטין רווח אחרי פסקה
                                                                 With Selection
                                                                  For B = 1 To .Paragraphs.Count
                                              
                                                                    .Paragraphs(B).Format.SpaceAfter = .Paragraphs(B).Format.SpaceAfter - PPS
                                                                    Next B
                                                                        End With
                                            
                                               
                                                                      'עבור לפסקה הבאה
                                                                  Selection.MoveDown wdParagraph, 1
                                                                      Next P
                                                             'אחרת עובר עמוד
                                                              Else
                                                              'עבור לפסקה הבאה
                                                             Endcol2.Select
                                                             Selection.MoveDown wdParagraph, 1
                                                                MsgBox ("לא עומד בקרטיונים שנקבעו נא נסה לערוך ידנית")
                                                               End If
                                                                End If
                                                  End If
                                                 
                                              
                                                         'אם טור 2 ארוך מ1
                                                          ElseIf col2 > col1 Then
                                                               'בודק אם רווח לא קטן מ2.5
                                                                   If SpaceAfter - PPS > 2.5 Then
                                            
                                                                 'מפעיל פקודת תיקון בלולאה *מס' פסקאות
                                                                  For P = 1 To Pcol2
                                         
                                                                    'מקטין רווח אחרי פסקה
                                                                  With Selection
                                                                   For B = 1 To .Paragraphs.Count
                                                                   .Paragraphs(B).Format.SpaceAfter = .Paragraphs(B).Format.SpaceAfter - PPS
                                                                   Next B
                                                                  End With
                                          
                                          
                                                                 'עבור לפסקה הבאה
                                                              Selection.MoveDown wdParagraph, 1
                                                                  Next P
                                          
                                                                  'אחרת עורך טור 1
                                                                   Else
                                                
                                                           If Pcol1 = 0 Then
                                                            'אחרת עובר עמוד
                                                            
                                                         Endcol2.Select
                                                         Selection.MoveDown wdParagraph, 1
                                                         MsgBox ("לא עומד בקרטיונים שנקבעו נא נסה לערוך ידנית")
                                                         Else
                                                                    ' PPS - מחלק הפרש בין פסקאות
                                                                      PPS = Acol / Pcol1
                                        
                                                                         'עבור לשורה ראשונה בטור
                                                                          Startcol1.Select
                                          
                                                                         'בודק אם רווח לא  גדול מ25
                                                                            If SpaceAfter + PPS < 25 Then
                                                                             'מפעיל פקודת תיקון בלולאה *מס' פסקאות
                                                                              For P = 1 To Pcol1
                                         
                                                                            'מגדיל  רווח אחרי פסקה
                                                                             With Selection
                                                                              For B = 1 To .Paragraphs.Count
                                              
                                                                            .Paragraphs(B).Format.SpaceAfter = .Paragraphs(B).Format.SpaceAfter + PPS
                                                                               Next B
                                                                            End With
                                               
                                                                             'עבור לפסקה הבאה
                                                                              Selection.MoveDown wdParagraph, 1
                                                                               Next P
                                             
                                                                               'אחרת עובר עמוד
                                                                            Else
                                                                               'עבור לפסקה הבאה
                                                                                 Endcol2.Select
                                                                                 Selection.MoveDown wdParagraph, 1
                                                                                MsgBox ("לא עומד בקרטיונים שנקבעו נא נסה לערוך ידנית")
                                                                              End If
                                                                             End If
                                                                              End If
                                                           End If
                                                     End If
                                              End If
                                              
                                        
                                           My.Select
                                           
                                           Application.ScreenUpdating = True
                                        End Sub
                                        
                                        
                                        
                                        

                                        ליישור כל המסמך

                                        Dim WRange, Endcol1, Startcol1, Endcol2, Startcol2, Rcol1, Rcol2 As Range
                                        Dim NumLines, WPage, Pcol1, Pcol2, APcol, PPS, a, i, B, C, P, R, S, G, col1, col2, Acol, Ignore As Double
                                        
                                        Public Sub יישור_טורים_בכל_המסמך_חדש()
                                        'עדכון מסך שקר
                                        Application.ScreenUpdating = False
                                        'מספר פסקאות
                                        
                                        
                                        'תחילה בסוף מסמך מוסיף תו כטור 1
                                        Selection.WholeStory
                                        Set Whole = Selection.Range
                                        Whole.SetRange Start:=Whole.End, End:=Whole.End
                                        Whole.Select
                                        If Selection.PageSetup.TextColumns.Count = 2 Then
                                         ActiveDocument.Range(Start:=Selection.Start, End:=Selection.Start). _
                                                InsertBreak Type:=wdSectionBreakContinuous
                                            Selection.Start = Selection.Start + 1
                                        ActiveDocument.Range(Start:=Selection.End, End:=Selection.End).InsertBreak _
                                                 Type:=wdSectionBreakContinuous
                                            With Selection.PageSetup.TextColumns
                                                .SetCount NumColumns:=1
                                                .EvenlySpaced = True
                                                .LineBetween = False
                                            End With
                                                Else
                                            End If
                                            'עובר לפסקה ראשונה
                                            ActiveDocument.Paragraphs(1).Range.Select
                                            'נכנס לללואה על כל המסמך
                                            For R = 1 To ActiveDocument.Paragraphs.Count / 3
                                        'בודק אם יש שני טורים
                                        If Selection.PageSetup.TextColumns.Count = 2 Then
                                               Application.Run MacroName:="עורך_טורים"
                                                Else
                                            Selection.MoveDown wdParagraph, 1
                                            End If
                                            
                                              Next R
                                             
                                           Application.ScreenUpdating = True
                                        End Sub
                                        
                                        Public Sub עורך_טורים()
                                        'עדכון מסך שקר
                                        Application.ScreenUpdating = False
                                        Dim WRange, Endcol2, Startcol1, Rcol1, Rcol2 As Range
                                        Dim NumLines, WPage, Pcol1, Pcol2, APcol, PPS, LM, a, i, B, C, P, S, col1, col2, Acol, Ignore As Double
                                        
                                        'שומר תחילת שורה של מיקום נוכחי
                                        Selection.HomeKey Unit:=wdLine
                                        Set My = Selection.Range
                                        
                                        'בחר את כל העמוד
                                        Set WRange = ActiveDocument.Bookmarks("\page").Range
                                        
                                        'עובר לתחילת עמוד
                                        WRange.SetRange Start:=WRange.Start, End:=WRange.Start + 1
                                        WRange.Select
                                        Set Startpage = Selection.Range
                                        WRange.SetRange Start:=Startpage.End, End:=My.End
                                        'סופר שורות
                                        WRange.Select
                                        SLines = Selection.Range.ComputeStatistics(wdStatisticLines)
                                        'חוזר ומפעיל לולאת בדיקה שאין כותרת'
                                        My.Select
                                        'Startcol1 מגדיר תחילת טור 1
                                        Set Startcol1 = Selection.Range
                                        For S = 1 To SLines - 1
                                            Selection.GoTo What:=wdGoToLine, Which:=wdGoToPrevious, Count:=1, Name:=""
                                             If Selection.PageSetup.TextColumns.Count <> 2 Then
                                                Exit For
                                            Else
                                                Set Startcol1 = Selection.Range
                                            End If
                                        Next
                                        'סוף עמוד
                                        Set WRange = ActiveDocument.Bookmarks("\page").Range
                                        WRange.SetRange Start:=WRange.End - 1, End:=WRange.End
                                        WRange.Select
                                        Set Endpage = Selection.Range
                                        WRange.SetRange Start:=My.Start, End:=Endpage.End
                                        'סופר שורות
                                        WRange.Select
                                        ELines = Selection.Range.ComputeStatistics(wdStatisticLines)
                                        My.Select
                                        'Endcol2מגדיר סוף טור 2
                                        Set Endcol2 = Selection.Range
                                        For S = 1 To ELines - 1
                                            Selection.GoTo What:=wdGoToLine, Which:=wdGoToNext, Count:=1, Name:=""
                                             If Selection.PageSetup.TextColumns.Count <> 2 Then
                                                Exit For
                                            Else
                                                Set Endcol2 = Selection.Range
                                            End If
                                        Next
                                        
                                        'מספר שורות כולל שני טורים
                                        Set WRange = Selection.Range
                                        WRange.SetRange Start:=Startcol1.End, End:=Endcol2.End
                                        WRange.Select
                                        NumLines = Selection.Range.ComputeStatistics(wdStatisticLines)
                                        ' - col2 מגדיר גובה טור 2
                                        Endcol2.Select
                                        col2 = Endcol2.Information(wdVerticalPositionRelativeToPage)
                                        Selection.EndKey Unit:=wdLine
                                        Set Endcol2 = Selection.Range
                                        
                                        
                                        '  col1מגדיר גובה טור -1
                                        'Endcol1- סוף טור 1
                                        'Startcol2- תחילת טור2
                                        
                                        Startcol1.Select
                                        For i = 1 To NumLines
                                            Selection.GoTo What:=wdGoToLine, Which:=wdGoToNext, Count:=1, Name:=""
                                           If col1 > Selection.Information(wdVerticalPositionRelativeToPage) Then
                                          Set Startcol2 = Selection.Range
                                                Exit For
                                            Else
                                                col1 = Selection.Information(wdVerticalPositionRelativeToPage)
                                               Set Endcol1 = Selection.Range
                                            End If
                                            
                                        Next
                                        'סוף טור 1 = סוף שורה
                                        Endcol1.Select
                                        Selection.EndKey Unit:=wdLine
                                        Set Endcol1 = Selection.Range
                                        
                                        'Acol מגדיר הפרש בין טורים
                                                If col1 > col2 Then Acol = col1 - col2
                                                If col1 < col2 Then Acol = col2 - col1
                                            
                                            'בודק אם טורים ישרים
                                        
                                          If Acol < 0.05 Then
                                          'עובר לעמודה הבאה
                                          Endcol2.Select
                                             Selection.MoveDown wdParagraph, 1
                                              
                                           Else
                                            
                                        'Pcol1 - מספר פסקאות טור 1
                                            WRange.SetRange Start:=Startcol1.Start, End:=Endcol1.End - 2
                                            WRange.Select
                                           Set Rcol1 = Selection.Range
                                             Rcol1.Select
                                          Pcol1 = (Rcol1.ComputeStatistics(wdStatisticParagraphs))
                                        
                                        'Pcol2 - מספר פסקאות טור 2
                                            WRange.SetRange Start:=Startcol2.Start, End:=Endcol2.End - 2
                                            WRange.Select
                                            Set Rcol2 = Selection.Range
                                             Rcol2.Select
                                           Pcol2 = (Rcol2.ComputeStatistics(wdStatisticParagraphs))
                                        
                                        If Pcol1 > Pcol2 Then
                                        
                                                'עורך טור1
                                          
                                                ' PPS - מחלק הפרש בין פסקאות
                                                    PPS = Acol / Pcol1
                                        
                                                     'עבור לשורה ראשונה בטור
                                                          Startcol1.Select
                                            
                                                        ' 'אם טור 1 ארוך מ2
                                                        If col1 > col2 Then
                                                          'בודק אם רווח לא קטן מ2.5
                                                          If SpaceAfter - PPS > 2.5 Then
                                                         'מפעיל פקודת תיקון בלולאה *מס' פסקאות
                                                            For P = 1 To Pcol1
                                         
                                                    'מקטין רווח אחרי פסקה
                                                       With Selection
                                                               For B = 1 To .Paragraphs.Count
                                              
                                                          .Paragraphs(B).Format.SpaceAfter = .Paragraphs(B).Format.SpaceAfter - PPS
                                                           Next B
                                                         End With
                                                
                                                     'עבור לפסקה הבאה
                                                      Selection.MoveDown wdParagraph, 1
                                                      Next P
                                                        'אחרת עורך טור 2
                                                           Else
                                                           If Pcol2 = 0 Then
                                                            'אחרת עובר עמוד
                                                            
                                                         Endcol2.Select
                                                         Selection.MoveDown wdParagraph, 1
                                                         
                                                         Else
                                                              PPS = Acol / Pcol2
                                                           'עבור לשורה ראשונה בטור 2
                                                            Startcol2.Select
                                          
                                                             'בודק אם רווח לא גדול מ25
                                        
                                                            If SpaceAfter + PPS < 25 Then
                                                           'מפעיל פקודת תיקון בלולאה *מס' פסקאות
                                                            For P = 1 To Pcol2
                                                        'מוסיף רווח אחרי פסקה
                                                           With Selection
                                                           For B = 1 To .Paragraphs.Count
                                                            .Paragraphs(B).Format.SpaceAfter = .Paragraphs(B).Format.SpaceAfter + PPS
                                                            Next B
                                                          End With
                                        
                                                         'עבור לפסקה הבאה
                                                          Selection.MoveDown wdParagraph, 1
                                                          Next P
                                           
                                                              'אחרת עובר עמוד
                                                            Else
                                                           'עבור לפסקה הבאה
                                                         Endcol2.Select
                                                         Selection.MoveDown wdParagraph, 1
                                                          End If
                                                           End If
                                                  End If
                                            
                                                     'אם טור 2 ארוך מ1
                                                     ElseIf col1 < col2 Then
                                              
                                                            'בודק אם רווח לא גדול מ25
                                                             If SpaceAfter + PPS < 25 Then
                                                             'מפעיל פקודת תיקון בלולאה *מס' פסקאות
                                                            For P = 1 To Pcol1
                                                            'מוסיף רווח אחרי פסקה
                                                              With Selection
                                                              For B = 1 To .Paragraphs.Count
                                                                .Paragraphs(B).Format.SpaceAfter = .Paragraphs(B).Format.SpaceAfter + PPS
                                                             Next B
                                                              End With
                                             
                                                             'עבור לפסקה הבאה
                                                               Selection.MoveDown wdParagraph, 1
                                                            Next P
                                             
                                                            'אחרת שרווח יהיה גדול מ25 עורך טור 2
                                                             Else
                                                              If Pcol2 = 0 Then
                                                            'אחרת עובר עמוד
                                                            
                                                         Endcol2.Select
                                                         Selection.MoveDown wdParagraph, 1
                                                         
                                                         Else
                                                              PPS = Acol / Pcol2
                                                               'עבור לשורה ראשונה בטור 2
                                                                   Startcol2.Select
                                          
                                                                 'בודק אם רווח לא קטן מ2.5
                                                                 If SpaceAfter - PPS > 2.5 Then
                                            
                                                             'מפעיל פקודת תיקון בלולאה *מס' פסקאות
                                                                For P = 1 To Pcol2
                                                                'מקטין רווח אחרי פסקה
                                                              With Selection
                                                               For B = 1 To .Paragraphs.Count
                                                            .Paragraphs(B).Format.SpaceAfter = .Paragraphs(B).Format.SpaceAfter - PPS
                                                           Next B
                                                          End With
                                          
                                                         'עבור לפסקה הבאה
                                                          Selection.MoveDown wdParagraph, 1
                                                             Next P
                                          
                                                          'אחרת עובר עמוד
                                                              Else
                                                              'עבור לפסקה הבאה
                                                       Endcol2.Select
                                                         Selection.MoveDown wdParagraph, 1
                                                               End If
                                                               End If
                                                            End If
                                                             End If
                                            'אם טור 2 רב פסקאות או שווה
                                        ElseIf Pcol2 > Pcol1 Or Pcol2 = Pcol1 Then
                                        
                                                'עורך טור 2
                                        
                                                    'מחלק הפרש בין פסקאות
                                            
                                                       PPS = Acol / Pcol2
                                                   'עבור לשורה ראשונה בטור 2
                                                     Startcol2.Select
                                            
                                                    'אם טור 1 ארוך מ2
                                                       If col1 > col2 Then
                                                              'בודק אם רווח לא גדול מ25
                                                              If SpaceAfter + PPS < 25 Then
                                              
                                                              'מפעיל פקודת תיקון בלולאה *מס' פסקאות
                                                               For P = 1 To Pcol2
                                          
                                                        'מוסיף רווח אחרי פסקה
                                                           With Selection
                                                          For B = 1 To .Paragraphs.Count
                                                           .Paragraphs(B).Format.SpaceAfter = .Paragraphs(B).Format.SpaceAfter + PPS
                                                            Next B
                                                          End With
                                         
                                          
                                                         'עבור לפסקה הבאה
                                                          Selection.MoveDown wdParagraph, 1
                                                               Next P
                                           
                                                         'אחרת עורך טור 1
                                                              Else
                                                           If Pcol1 = 0 Then
                                                            'אחרת עובר עמוד
                                                            
                                                         Endcol2.Select
                                                         Selection.MoveDown wdParagraph, 1
                                                         
                                                         Else
                                                            ' PPS - מחלק הפרש בין פסקאות
                                                               PPS = Acol / Pcol1
                                        
                                                            'עבור לשורה ראשונה בטור
                                                                  Startcol1.Select
                                        
                                                              'בודק אם רווח לא קטן מ2.5
                                                              If SpaceAfter - PPS > 2.5 Then
                                            
                                                               'מפעיל פקודת תיקון בלולאה *מס' פסקאות
                                                            For P = 1 To Pcol1
                                         
                                                            'מקטין רווח אחרי פסקה
                                                                 With Selection
                                                                  For B = 1 To .Paragraphs.Count
                                              
                                                                    .Paragraphs(B).Format.SpaceAfter = .Paragraphs(B).Format.SpaceAfter - PPS
                                                                    Next B
                                                                        End With
                                            
                                               
                                                                      'עבור לפסקה הבאה
                                                                  Selection.MoveDown wdParagraph, 1
                                                                      Next P
                                                             'אחרת עובר עמוד
                                                              Else
                                                              'עבור לפסקה הבאה
                                                             Endcol2.Select
                                                             Selection.MoveDown wdParagraph, 1
                                        
                                                               End If
                                                                End If
                                                  End If
                                                 
                                              
                                                         'אם טור 2 ארוך מ1
                                                          ElseIf col2 > col1 Then
                                                               'בודק אם רווח לא קטן מ2.5
                                                                   If SpaceAfter - PPS > 2.5 Then
                                            
                                                                 'מפעיל פקודת תיקון בלולאה *מס' פסקאות
                                                                  For P = 1 To Pcol2
                                         
                                                                    'מקטין רווח אחרי פסקה
                                                                  With Selection
                                                                   For B = 1 To .Paragraphs.Count
                                                                   .Paragraphs(B).Format.SpaceAfter = .Paragraphs(B).Format.SpaceAfter - PPS
                                                                   Next B
                                                                  End With
                                          
                                          
                                                                 'עבור לפסקה הבאה
                                                              Selection.MoveDown wdParagraph, 1
                                                                  Next P
                                          
                                                                  'אחרת עורך טור 1
                                                                   Else
                                                
                                                           If Pcol1 = 0 Then
                                                            'אחרת עובר עמוד
                                                            
                                                         Endcol2.Select
                                                         Selection.MoveDown wdParagraph, 1
                                                         
                                                         Else
                                                                    ' PPS - מחלק הפרש בין פסקאות
                                                                      PPS = Acol / Pcol1
                                        
                                                                         'עבור לשורה ראשונה בטור
                                                                          Startcol1.Select
                                          
                                                                         'בודק אם רווח לא  גדול מ25
                                                                            If SpaceAfter + PPS < 25 Then
                                                                             'מפעיל פקודת תיקון בלולאה *מס' פסקאות
                                                                              For P = 1 To Pcol1
                                         
                                                                            'מגדיל  רווח אחרי פסקה
                                                                             With Selection
                                                                              For B = 1 To .Paragraphs.Count
                                              
                                                                            .Paragraphs(B).Format.SpaceAfter = .Paragraphs(B).Format.SpaceAfter + PPS
                                                                               Next B
                                                                            End With
                                               
                                                                             'עבור לפסקה הבאה
                                                                              Selection.MoveDown wdParagraph, 1
                                                                               Next P
                                             
                                                                               'אחרת עובר עמוד
                                                                            Else
                                                                               'עבור לפסקה הבאה
                                                                                 Endcol2.Select
                                                                                 Selection.MoveDown wdParagraph, 1
                                         
                                                                              End If
                                                                             End If
                                                                              End If
                                                           End If
                                                     End If
                                               'עובר לעמודה הבאה
                                          Endcol2.Select
                                             Selection.MoveDown wdParagraph, 1
                                        
                                           
                                              End If
                                        
                                              'עובר לעמודה הבאה
                                          Endcol2.Select
                                             Selection.MoveDown wdParagraph, 1
                                        
                                           
                                           
                                           
                                           Application.ScreenUpdating = True
                                        End Sub
                                        
                                        
                                        

                                        ושאר הקודים בקובץ המצ"ב

                                        M מנותק
                                        M מנותק
                                        mfmf
                                        כתב ב נערך לאחרונה על ידי
                                        #36

                                        @רפרם-ב-ר-פפא תודה רבה!
                                        עוזר מאד מאד!!

                                        תגובה 1 תגובה אחרונה
                                        0
                                        • ר רפרם ב"ר פפא

                                          בסייעתא דשמיא
                                          עדכון המאקרו יישור טורים - תוספות ותיקונים
                                          בהמשך להערות וההארות שנכתבו בשרשור זה בסייעתא דשמיא הנני להציע לציבור היקר את מאקרו יישור טורים גרסה 3
                                          א.סודר ענין השגיאה של מרווח פחות מ0
                                          וכמו כן נקבע שמרווח בין פסקאות לא יוכל לחרוג מטווח של 2.5 נקודות מינימום ו25 נקודת מקסימום (וזה לצורך הנראות הבסיסית) ונוסף גם שכשלא מצליח בטור הראשון (שהוא רב בפסקאות לעומת השני) מנסה בטור השני (ואם בשני טורים לא עומד בכללים אז ביישור מסמך שלם או מספר עמודים מדלג באופן אוטומטי לעמוד הבא וביישור עמוד אחד מודיע שלא עומד בכללים שהוצבו)
                                          ב. כמו כן מדלג על מסגרות ותיבות טקסט
                                          (ג. כמו כן מאחר שהוגדר מינימום 2.5 נקודות ממילא לא תהיה בעיה של עובי כתב בכותרת)
                                          ד. נוסף פקודה יישור ממיקום הסמן עד סוף כל המסמך (וטוב במקרה של באג וכו לדלג על המקום הבעייתי)
                                          ה. נוסף פקודה ליישור מכותרת על טור 1 עד כותרת הבאה (דהיינו סימן אחד בקונטרס)
                                          ו. ביישור כל המסמך במקרה שיש כותרת באמצע עמוד מיישר גם את החלק העליון וגם את התחתון
                                          בהצלחה
                                          ואשמח לשמוע אם עובד כמצופה וכן על באגים שלא יהיו וכן הצעות ייעול
                                          נראה שהוא דבר שיכול להועיל להרבה משתמשים ולחסוך זמן לכן אני מקווה לעשות כתוסף לכשיהיה מושלם
                                          וכן בכוונתי להוסיף אפשרות להגדיר את הטווח מינימום ומקסימום ועוד בל"נ
                                          הכל בעזרתו יתברך ובישועתו
                                          מצ"ב הקובץיישור טורים 3.dotm ועודכן בפוסט הראשי

                                          והקוד המתוקן והמשופץ
                                          ליישור עמוד אחד

                                          
                                          Dim WRange, Endcol2, Startcol1, Rcol1, Rcol2 As Range
                                          Dim NumLines, WPage, Pcol1, Pcol2, APcol, PPS, a, i, B, C, LM, P, S, V, col1, col2, Acol, Ignore As Double
                                          
                                          Public Sub יישור_טורים_עמוד_זה()
                                          
                                          'בודק אם יש שני טורים
                                          If Selection.PageSetup.TextColumns.Count <> 2 Then MsgBox ("לא נמצאו 2 טורים"): Exit Sub
                                          'עדכון מסך שקר
                                          Application.ScreenUpdating = False
                                          Dim WRange, Endcol2, Startcol1, Rcol1, Rcol2 As Range
                                          Dim NumLines, WPage, Pcol1, Pcol2, APcol, PPS, a, i, B, C, LM, P, S, V, col1, col2, Acol, Ignore As Double
                                          
                                          'שומר תחילת שורה של מיקום נוכחי
                                          Selection.HomeKey Unit:=wdLine
                                          Set My = Selection.Range
                                          
                                          'בחר את כל העמוד
                                          Set WRange = ActiveDocument.Bookmarks("\page").Range
                                          
                                          'עובר לתחילת עמוד
                                          WRange.SetRange Start:=WRange.Start, End:=WRange.Start + 1
                                          WRange.Select
                                          Set Startpage = Selection.Range
                                          WRange.SetRange Start:=Startpage.End, End:=My.End
                                          'סופר שורות
                                          WRange.Select
                                          SLines = Selection.Range.ComputeStatistics(wdStatisticLines)
                                          'חוזר ומפעיל לולאת בדיקה שאין כותרת'
                                          My.Select
                                          'Startcol1 מגדיר תחילת טור 1
                                            Set Startcol1 = Selection.Range
                                          For S = 1 To SLines - 1
                                              Selection.GoTo What:=wdGoToLine, Which:=wdGoToPrevious, Count:=1, Name:=""
                                               If Selection.PageSetup.TextColumns.Count <> 2 Then
                                                  Exit For
                                              Else
                                                  Set Startcol1 = Selection.Range
                                              End If
                                          Next
                                          'סוף עמוד
                                          Set WRange = ActiveDocument.Bookmarks("\page").Range
                                          WRange.SetRange Start:=WRange.End - 1, End:=WRange.End
                                          WRange.Select
                                          Set Endpage = Selection.Range
                                          WRange.SetRange Start:=My.Start, End:=Endpage.End
                                          'סופר שורות
                                          WRange.Select
                                          ELines = Selection.Range.ComputeStatistics(wdStatisticLines)
                                          My.Select
                                          'Endcol2 מגדיר סוף טור 2
                                          Set Endcol2 = Selection.Range
                                          For S = 1 To ELines - 1
                                              Selection.GoTo What:=wdGoToLine, Which:=wdGoToNext, Count:=1, Name:=""
                                               If Selection.PageSetup.TextColumns.Count <> 2 Then
                                                  Exit For
                                              Else
                                                  Set Endcol2 = Selection.Range
                                              End If
                                          Next
                                          
                                          'מספר שורות כולל שני טורים
                                          Set WRange = Selection.Range
                                          WRange.SetRange Start:=Startcol1.End, End:=Endcol2.End
                                          WRange.Select
                                          NumLines = Selection.Range.ComputeStatistics(wdStatisticLines)
                                          ' - col2 מגדיר גובה טור 2
                                          Endcol2.Select
                                          col2 = Endcol2.Information(wdVerticalPositionRelativeToPage)
                                          Selection.EndKey Unit:=wdLine
                                          Set Endcol2 = Selection.Range
                                          
                                          
                                          '  col1מגדיר גובה טור =1
                                          'Endcol1= סוף טור 1
                                          'Startcol2= תחילת טור2
                                          
                                          Startcol1.Select
                                          For i = 1 To NumLines
                                              Selection.GoTo What:=wdGoToLine, Which:=wdGoToNext, Count:=1, Name:=""
                                             If col1 > Selection.Information(wdVerticalPositionRelativeToPage) Then
                                            Set Startcol2 = Selection.Range
                                                  Exit For
                                              Else
                                                  col1 = Selection.Information(wdVerticalPositionRelativeToPage)
                                                 Set Endcol1 = Selection.Range
                                              End If
                                              
                                          Next
                                          'סוף טור 1 = סוף שורה
                                          Endcol1.Select
                                          Selection.EndKey Unit:=wdLine
                                          Set Endcol1 = Selection.Range
                                          
                                          'Acol= מגדיר הפרש בין טורים
                                                  If col1 > col2 Then Acol = col1 - col2
                                                  If col1 < col2 Then Acol = col2 - col1
                                              
                                              'בודק אם טורים ישרים
                                          
                                            If Acol < 0.05 Then
                                              MsgBox "טורים ישרים"
                                           'אם רווח גדול מידי מוסיף בסוף פסקה מעבר מקטע בטור 1
                                             ElseIf Acol > 30 Then
                                             Endcol2.Select
                                           ActiveDocument.Range(Start:=Selection.Start, End:=Selection.Start). _
                                                  InsertBreak Type:=wdSectionBreakContinuous
                                              Selection.Start = Selection.Start + 1
                                          ActiveDocument.Range(Start:=Selection.End, End:=Selection.End).InsertBreak _
                                                   Type:=wdSectionBreakContinuous
                                              With Selection.PageSetup.TextColumns
                                                  .SetCount NumColumns:=1
                                                  .EvenlySpaced = True
                                                  .LineBetween = False
                                              End With
                                              
                                             Else
                                              
                                          'Pcol1 = מספר פסקאות טור 1
                                              WRange.SetRange Start:=Startcol1.Start, End:=Endcol1.End - 2
                                              WRange.Select
                                             Set Rcol1 = Selection.Range
                                               Rcol1.Select
                                            Pcol1 = (Rcol1.ComputeStatistics(wdStatisticParagraphs))
                                          
                                          'Pcol2 = מספר פסקאות טור 2
                                              WRange.SetRange Start:=Startcol2.Start, End:=Endcol2.End - 2
                                              WRange.Select
                                              Set Rcol2 = Selection.Range
                                               Rcol2.Select
                                             Pcol2 = (Rcol2.ComputeStatistics(wdStatisticParagraphs))
                                          'טור מרובה פסקאות
                                          If Pcol1 > Pcol2 Then
                                          
                                                  'עורך טור1
                                            
                                                  ' PPS - מחלק הפרש בין פסקאות
                                                      PPS = Acol / Pcol1
                                          
                                                       'עבור לשורה ראשונה בטור
                                                            Startcol1.Select
                                              
                                                          ' 'אם טור 1 ארוך מ2
                                                          If col1 > col2 Then
                                                            'בודק אם רווח לא קטן מ2.5
                                                            If SpaceAfter - PPS > 2.5 Then
                                                           'מפעיל פקודת תיקון בלולאה *מס' פסקאות
                                                              For P = 1 To Pcol1
                                           
                                                      'מקטין רווח אחרי פסקה
                                                         With Selection
                                                                 For B = 1 To .Paragraphs.Count
                                                
                                                            .Paragraphs(B).Format.SpaceAfter = .Paragraphs(B).Format.SpaceAfter - PPS
                                                             Next B
                                                           End With
                                                  
                                                       'עבור לפסקה הבאה
                                                        Selection.MoveDown wdParagraph, 1
                                                        Next P
                                                          'אחרת עורך טור 2
                                                             Else
                                                             If Pcol2 = 0 Then
                                                              'אחרת עובר עמוד
                                                              
                                                           Endcol2.Select
                                                           Selection.MoveDown wdParagraph, 1
                                                           MsgBox ("לא עומד בקרטיונים שנקבעו נא נסה לערוך ידנית")
                                                           Else
                                                                PPS = Acol / Pcol2
                                                             'עבור לשורה ראשונה בטור 2
                                                              Startcol2.Select
                                            
                                                               'בודק אם רווח לא גדול מ25
                                          
                                                              If SpaceAfter + PPS < 25 Then
                                                             'מפעיל פקודת תיקון בלולאה *מס' פסקאות
                                                              For P = 1 To Pcol2
                                                          'מוסיף רווח אחרי פסקה
                                                             With Selection
                                                             For B = 1 To .Paragraphs.Count
                                                              .Paragraphs(B).Format.SpaceAfter = .Paragraphs(B).Format.SpaceAfter + PPS
                                                              Next B
                                                            End With
                                          
                                                           'עבור לפסקה הבאה
                                                            Selection.MoveDown wdParagraph, 1
                                                            Next P
                                             
                                                                'אחרת עובר עמוד
                                                              Else
                                                             'עבור לפסקה הבאה
                                                           Endcol2.Select
                                                           Selection.MoveDown wdParagraph, 1
                                                           MsgBox ("לא עומד בקרטיונים שנקבעו נא נסה לערוך ידנית")
                                                            End If
                                                             End If
                                                    End If
                                              
                                                       'אם טור 2 ארוך מ1
                                                       ElseIf col1 < col2 Then
                                                
                                                              'בודק אם רווח לא גדול מ25
                                                               If SpaceAfter + PPS < 25 Then
                                                               'מפעיל פקודת תיקון בלולאה *מס' פסקאות
                                                              For P = 1 To Pcol1
                                                              'מוסיף רווח אחרי פסקה
                                                                With Selection
                                                                For B = 1 To .Paragraphs.Count
                                                                  .Paragraphs(B).Format.SpaceAfter = .Paragraphs(B).Format.SpaceAfter + PPS
                                                               Next B
                                                                End With
                                               
                                                               'עבור לפסקה הבאה
                                                                 Selection.MoveDown wdParagraph, 1
                                                              Next P
                                               
                                                              'אחרת שרווח יהיה גדול מ25 עורך טור 2
                                                               Else
                                                                If Pcol2 = 0 Then
                                                              'אחרת עובר עמוד
                                                              
                                                           Endcol2.Select
                                                           Selection.MoveDown wdParagraph, 1
                                                           MsgBox ("לא עומד בקרטיונים שנקבעו נא נסה לערוך ידנית")
                                                           Else
                                                                PPS = Acol / Pcol2
                                                                 'עבור לשורה ראשונה בטור 2
                                                                     Startcol2.Select
                                            
                                                                   'בודק אם רווח לא קטן מ2.5
                                                                   If SpaceAfter - PPS > 2.5 Then
                                              
                                                               'מפעיל פקודת תיקון בלולאה *מס' פסקאות
                                                                  For P = 1 To Pcol2
                                                                  'מקטין רווח אחרי פסקה
                                                                With Selection
                                                                 For B = 1 To .Paragraphs.Count
                                                              .Paragraphs(B).Format.SpaceAfter = .Paragraphs(B).Format.SpaceAfter - PPS
                                                             Next B
                                                            End With
                                            
                                                           'עבור לפסקה הבאה
                                                            Selection.MoveDown wdParagraph, 1
                                                               Next P
                                            
                                                            'אחרת עובר עמוד
                                                                Else
                                                                'עבור לפסקה הבאה
                                                         Endcol2.Select
                                                           Selection.MoveDown wdParagraph, 1
                                                           MsgBox ("לא עומד בקרטיונים שנקבעו נא נסה לערוך ידנית")
                                                                 End If
                                                                 End If
                                                              End If
                                                               End If
                                              'אם טור 2 רב פסקאות או שווה
                                          ElseIf Pcol2 > Pcol1 Or Pcol2 = Pcol1 Then
                                          
                                                  'עורך טור 2
                                          
                                                      'מחלק הפרש בין פסקאות
                                              
                                                         PPS = Acol / Pcol2
                                                     'עבור לשורה ראשונה בטור 2
                                                       Startcol2.Select
                                              
                                                      'אם טור 1 ארוך מ2
                                                         If col1 > col2 Then
                                                                'בודק אם רווח לא גדול מ25
                                                                If SpaceAfter + PPS < 25 Then
                                                
                                                                'מפעיל פקודת תיקון בלולאה *מס' פסקאות
                                                                 For P = 1 To Pcol2
                                            
                                                          'מוסיף רווח אחרי פסקה
                                                             With Selection
                                                            For B = 1 To .Paragraphs.Count
                                                             .Paragraphs(B).Format.SpaceAfter = .Paragraphs(B).Format.SpaceAfter + PPS
                                                              Next B
                                                            End With
                                           
                                            
                                                           'עבור לפסקה הבאה
                                                            Selection.MoveDown wdParagraph, 1
                                                                 Next P
                                             
                                                           'אחרת עורך טור 1
                                                                Else
                                                             If Pcol1 = 0 Then
                                                              'אחרת עובר עמוד
                                                              
                                                           Endcol2.Select
                                                           Selection.MoveDown wdParagraph, 1
                                                           MsgBox ("לא עומד בקרטיונים שנקבעו נא נסה לערוך ידנית")
                                                           Else
                                                              ' PPS - מחלק הפרש בין פסקאות
                                                                 PPS = Acol / Pcol1
                                          
                                                              'עבור לשורה ראשונה בטור
                                                                    Startcol1.Select
                                          
                                                                'בודק אם רווח לא קטן מ2.5
                                                                If SpaceAfter - PPS > 2.5 Then
                                              
                                                                 'מפעיל פקודת תיקון בלולאה *מס' פסקאות
                                                              For P = 1 To Pcol1
                                           
                                                              'מקטין רווח אחרי פסקה
                                                                   With Selection
                                                                    For B = 1 To .Paragraphs.Count
                                                
                                                                      .Paragraphs(B).Format.SpaceAfter = .Paragraphs(B).Format.SpaceAfter - PPS
                                                                      Next B
                                                                          End With
                                              
                                                 
                                                                        'עבור לפסקה הבאה
                                                                    Selection.MoveDown wdParagraph, 1
                                                                        Next P
                                                               'אחרת עובר עמוד
                                                                Else
                                                                'עבור לפסקה הבאה
                                                               Endcol2.Select
                                                               Selection.MoveDown wdParagraph, 1
                                                                  MsgBox ("לא עומד בקרטיונים שנקבעו נא נסה לערוך ידנית")
                                                                 End If
                                                                  End If
                                                    End If
                                                   
                                                
                                                           'אם טור 2 ארוך מ1
                                                            ElseIf col2 > col1 Then
                                                                 'בודק אם רווח לא קטן מ2.5
                                                                     If SpaceAfter - PPS > 2.5 Then
                                              
                                                                   'מפעיל פקודת תיקון בלולאה *מס' פסקאות
                                                                    For P = 1 To Pcol2
                                           
                                                                      'מקטין רווח אחרי פסקה
                                                                    With Selection
                                                                     For B = 1 To .Paragraphs.Count
                                                                     .Paragraphs(B).Format.SpaceAfter = .Paragraphs(B).Format.SpaceAfter - PPS
                                                                     Next B
                                                                    End With
                                            
                                            
                                                                   'עבור לפסקה הבאה
                                                                Selection.MoveDown wdParagraph, 1
                                                                    Next P
                                            
                                                                    'אחרת עורך טור 1
                                                                     Else
                                                  
                                                             If Pcol1 = 0 Then
                                                              'אחרת עובר עמוד
                                                              
                                                           Endcol2.Select
                                                           Selection.MoveDown wdParagraph, 1
                                                           MsgBox ("לא עומד בקרטיונים שנקבעו נא נסה לערוך ידנית")
                                                           Else
                                                                      ' PPS - מחלק הפרש בין פסקאות
                                                                        PPS = Acol / Pcol1
                                          
                                                                           'עבור לשורה ראשונה בטור
                                                                            Startcol1.Select
                                            
                                                                           'בודק אם רווח לא  גדול מ25
                                                                              If SpaceAfter + PPS < 25 Then
                                                                               'מפעיל פקודת תיקון בלולאה *מס' פסקאות
                                                                                For P = 1 To Pcol1
                                           
                                                                              'מגדיל  רווח אחרי פסקה
                                                                               With Selection
                                                                                For B = 1 To .Paragraphs.Count
                                                
                                                                              .Paragraphs(B).Format.SpaceAfter = .Paragraphs(B).Format.SpaceAfter + PPS
                                                                                 Next B
                                                                              End With
                                                 
                                                                               'עבור לפסקה הבאה
                                                                                Selection.MoveDown wdParagraph, 1
                                                                                 Next P
                                               
                                                                                 'אחרת עובר עמוד
                                                                              Else
                                                                                 'עבור לפסקה הבאה
                                                                                   Endcol2.Select
                                                                                   Selection.MoveDown wdParagraph, 1
                                                                                  MsgBox ("לא עומד בקרטיונים שנקבעו נא נסה לערוך ידנית")
                                                                                End If
                                                                               End If
                                                                                End If
                                                             End If
                                                       End If
                                                End If
                                                
                                          
                                             My.Select
                                             
                                             Application.ScreenUpdating = True
                                          End Sub
                                          
                                          
                                          
                                          

                                          ליישור כל המסמך

                                          Dim WRange, Endcol1, Startcol1, Endcol2, Startcol2, Rcol1, Rcol2 As Range
                                          Dim NumLines, WPage, Pcol1, Pcol2, APcol, PPS, a, i, B, C, P, R, S, G, col1, col2, Acol, Ignore As Double
                                          
                                          Public Sub יישור_טורים_בכל_המסמך_חדש()
                                          'עדכון מסך שקר
                                          Application.ScreenUpdating = False
                                          'מספר פסקאות
                                          
                                          
                                          'תחילה בסוף מסמך מוסיף תו כטור 1
                                          Selection.WholeStory
                                          Set Whole = Selection.Range
                                          Whole.SetRange Start:=Whole.End, End:=Whole.End
                                          Whole.Select
                                          If Selection.PageSetup.TextColumns.Count = 2 Then
                                           ActiveDocument.Range(Start:=Selection.Start, End:=Selection.Start). _
                                                  InsertBreak Type:=wdSectionBreakContinuous
                                              Selection.Start = Selection.Start + 1
                                          ActiveDocument.Range(Start:=Selection.End, End:=Selection.End).InsertBreak _
                                                   Type:=wdSectionBreakContinuous
                                              With Selection.PageSetup.TextColumns
                                                  .SetCount NumColumns:=1
                                                  .EvenlySpaced = True
                                                  .LineBetween = False
                                              End With
                                                  Else
                                              End If
                                              'עובר לפסקה ראשונה
                                              ActiveDocument.Paragraphs(1).Range.Select
                                              'נכנס לללואה על כל המסמך
                                              For R = 1 To ActiveDocument.Paragraphs.Count / 3
                                          'בודק אם יש שני טורים
                                          If Selection.PageSetup.TextColumns.Count = 2 Then
                                                 Application.Run MacroName:="עורך_טורים"
                                                  Else
                                              Selection.MoveDown wdParagraph, 1
                                              End If
                                              
                                                Next R
                                               
                                             Application.ScreenUpdating = True
                                          End Sub
                                          
                                          Public Sub עורך_טורים()
                                          'עדכון מסך שקר
                                          Application.ScreenUpdating = False
                                          Dim WRange, Endcol2, Startcol1, Rcol1, Rcol2 As Range
                                          Dim NumLines, WPage, Pcol1, Pcol2, APcol, PPS, LM, a, i, B, C, P, S, col1, col2, Acol, Ignore As Double
                                          
                                          'שומר תחילת שורה של מיקום נוכחי
                                          Selection.HomeKey Unit:=wdLine
                                          Set My = Selection.Range
                                          
                                          'בחר את כל העמוד
                                          Set WRange = ActiveDocument.Bookmarks("\page").Range
                                          
                                          'עובר לתחילת עמוד
                                          WRange.SetRange Start:=WRange.Start, End:=WRange.Start + 1
                                          WRange.Select
                                          Set Startpage = Selection.Range
                                          WRange.SetRange Start:=Startpage.End, End:=My.End
                                          'סופר שורות
                                          WRange.Select
                                          SLines = Selection.Range.ComputeStatistics(wdStatisticLines)
                                          'חוזר ומפעיל לולאת בדיקה שאין כותרת'
                                          My.Select
                                          'Startcol1 מגדיר תחילת טור 1
                                          Set Startcol1 = Selection.Range
                                          For S = 1 To SLines - 1
                                              Selection.GoTo What:=wdGoToLine, Which:=wdGoToPrevious, Count:=1, Name:=""
                                               If Selection.PageSetup.TextColumns.Count <> 2 Then
                                                  Exit For
                                              Else
                                                  Set Startcol1 = Selection.Range
                                              End If
                                          Next
                                          'סוף עמוד
                                          Set WRange = ActiveDocument.Bookmarks("\page").Range
                                          WRange.SetRange Start:=WRange.End - 1, End:=WRange.End
                                          WRange.Select
                                          Set Endpage = Selection.Range
                                          WRange.SetRange Start:=My.Start, End:=Endpage.End
                                          'סופר שורות
                                          WRange.Select
                                          ELines = Selection.Range.ComputeStatistics(wdStatisticLines)
                                          My.Select
                                          'Endcol2מגדיר סוף טור 2
                                          Set Endcol2 = Selection.Range
                                          For S = 1 To ELines - 1
                                              Selection.GoTo What:=wdGoToLine, Which:=wdGoToNext, Count:=1, Name:=""
                                               If Selection.PageSetup.TextColumns.Count <> 2 Then
                                                  Exit For
                                              Else
                                                  Set Endcol2 = Selection.Range
                                              End If
                                          Next
                                          
                                          'מספר שורות כולל שני טורים
                                          Set WRange = Selection.Range
                                          WRange.SetRange Start:=Startcol1.End, End:=Endcol2.End
                                          WRange.Select
                                          NumLines = Selection.Range.ComputeStatistics(wdStatisticLines)
                                          ' - col2 מגדיר גובה טור 2
                                          Endcol2.Select
                                          col2 = Endcol2.Information(wdVerticalPositionRelativeToPage)
                                          Selection.EndKey Unit:=wdLine
                                          Set Endcol2 = Selection.Range
                                          
                                          
                                          '  col1מגדיר גובה טור -1
                                          'Endcol1- סוף טור 1
                                          'Startcol2- תחילת טור2
                                          
                                          Startcol1.Select
                                          For i = 1 To NumLines
                                              Selection.GoTo What:=wdGoToLine, Which:=wdGoToNext, Count:=1, Name:=""
                                             If col1 > Selection.Information(wdVerticalPositionRelativeToPage) Then
                                            Set Startcol2 = Selection.Range
                                                  Exit For
                                              Else
                                                  col1 = Selection.Information(wdVerticalPositionRelativeToPage)
                                                 Set Endcol1 = Selection.Range
                                              End If
                                              
                                          Next
                                          'סוף טור 1 = סוף שורה
                                          Endcol1.Select
                                          Selection.EndKey Unit:=wdLine
                                          Set Endcol1 = Selection.Range
                                          
                                          'Acol מגדיר הפרש בין טורים
                                                  If col1 > col2 Then Acol = col1 - col2
                                                  If col1 < col2 Then Acol = col2 - col1
                                              
                                              'בודק אם טורים ישרים
                                          
                                            If Acol < 0.05 Then
                                            'עובר לעמודה הבאה
                                            Endcol2.Select
                                               Selection.MoveDown wdParagraph, 1
                                                
                                             Else
                                              
                                          'Pcol1 - מספר פסקאות טור 1
                                              WRange.SetRange Start:=Startcol1.Start, End:=Endcol1.End - 2
                                              WRange.Select
                                             Set Rcol1 = Selection.Range
                                               Rcol1.Select
                                            Pcol1 = (Rcol1.ComputeStatistics(wdStatisticParagraphs))
                                          
                                          'Pcol2 - מספר פסקאות טור 2
                                              WRange.SetRange Start:=Startcol2.Start, End:=Endcol2.End - 2
                                              WRange.Select
                                              Set Rcol2 = Selection.Range
                                               Rcol2.Select
                                             Pcol2 = (Rcol2.ComputeStatistics(wdStatisticParagraphs))
                                          
                                          If Pcol1 > Pcol2 Then
                                          
                                                  'עורך טור1
                                            
                                                  ' PPS - מחלק הפרש בין פסקאות
                                                      PPS = Acol / Pcol1
                                          
                                                       'עבור לשורה ראשונה בטור
                                                            Startcol1.Select
                                              
                                                          ' 'אם טור 1 ארוך מ2
                                                          If col1 > col2 Then
                                                            'בודק אם רווח לא קטן מ2.5
                                                            If SpaceAfter - PPS > 2.5 Then
                                                           'מפעיל פקודת תיקון בלולאה *מס' פסקאות
                                                              For P = 1 To Pcol1
                                           
                                                      'מקטין רווח אחרי פסקה
                                                         With Selection
                                                                 For B = 1 To .Paragraphs.Count
                                                
                                                            .Paragraphs(B).Format.SpaceAfter = .Paragraphs(B).Format.SpaceAfter - PPS
                                                             Next B
                                                           End With
                                                  
                                                       'עבור לפסקה הבאה
                                                        Selection.MoveDown wdParagraph, 1
                                                        Next P
                                                          'אחרת עורך טור 2
                                                             Else
                                                             If Pcol2 = 0 Then
                                                              'אחרת עובר עמוד
                                                              
                                                           Endcol2.Select
                                                           Selection.MoveDown wdParagraph, 1
                                                           
                                                           Else
                                                                PPS = Acol / Pcol2
                                                             'עבור לשורה ראשונה בטור 2
                                                              Startcol2.Select
                                            
                                                               'בודק אם רווח לא גדול מ25
                                          
                                                              If SpaceAfter + PPS < 25 Then
                                                             'מפעיל פקודת תיקון בלולאה *מס' פסקאות
                                                              For P = 1 To Pcol2
                                                          'מוסיף רווח אחרי פסקה
                                                             With Selection
                                                             For B = 1 To .Paragraphs.Count
                                                              .Paragraphs(B).Format.SpaceAfter = .Paragraphs(B).Format.SpaceAfter + PPS
                                                              Next B
                                                            End With
                                          
                                                           'עבור לפסקה הבאה
                                                            Selection.MoveDown wdParagraph, 1
                                                            Next P
                                             
                                                                'אחרת עובר עמוד
                                                              Else
                                                             'עבור לפסקה הבאה
                                                           Endcol2.Select
                                                           Selection.MoveDown wdParagraph, 1
                                                            End If
                                                             End If
                                                    End If
                                              
                                                       'אם טור 2 ארוך מ1
                                                       ElseIf col1 < col2 Then
                                                
                                                              'בודק אם רווח לא גדול מ25
                                                               If SpaceAfter + PPS < 25 Then
                                                               'מפעיל פקודת תיקון בלולאה *מס' פסקאות
                                                              For P = 1 To Pcol1
                                                              'מוסיף רווח אחרי פסקה
                                                                With Selection
                                                                For B = 1 To .Paragraphs.Count
                                                                  .Paragraphs(B).Format.SpaceAfter = .Paragraphs(B).Format.SpaceAfter + PPS
                                                               Next B
                                                                End With
                                               
                                                               'עבור לפסקה הבאה
                                                                 Selection.MoveDown wdParagraph, 1
                                                              Next P
                                               
                                                              'אחרת שרווח יהיה גדול מ25 עורך טור 2
                                                               Else
                                                                If Pcol2 = 0 Then
                                                              'אחרת עובר עמוד
                                                              
                                                           Endcol2.Select
                                                           Selection.MoveDown wdParagraph, 1
                                                           
                                                           Else
                                                                PPS = Acol / Pcol2
                                                                 'עבור לשורה ראשונה בטור 2
                                                                     Startcol2.Select
                                            
                                                                   'בודק אם רווח לא קטן מ2.5
                                                                   If SpaceAfter - PPS > 2.5 Then
                                              
                                                               'מפעיל פקודת תיקון בלולאה *מס' פסקאות
                                                                  For P = 1 To Pcol2
                                                                  'מקטין רווח אחרי פסקה
                                                                With Selection
                                                                 For B = 1 To .Paragraphs.Count
                                                              .Paragraphs(B).Format.SpaceAfter = .Paragraphs(B).Format.SpaceAfter - PPS
                                                             Next B
                                                            End With
                                            
                                                           'עבור לפסקה הבאה
                                                            Selection.MoveDown wdParagraph, 1
                                                               Next P
                                            
                                                            'אחרת עובר עמוד
                                                                Else
                                                                'עבור לפסקה הבאה
                                                         Endcol2.Select
                                                           Selection.MoveDown wdParagraph, 1
                                                                 End If
                                                                 End If
                                                              End If
                                                               End If
                                              'אם טור 2 רב פסקאות או שווה
                                          ElseIf Pcol2 > Pcol1 Or Pcol2 = Pcol1 Then
                                          
                                                  'עורך טור 2
                                          
                                                      'מחלק הפרש בין פסקאות
                                              
                                                         PPS = Acol / Pcol2
                                                     'עבור לשורה ראשונה בטור 2
                                                       Startcol2.Select
                                              
                                                      'אם טור 1 ארוך מ2
                                                         If col1 > col2 Then
                                                                'בודק אם רווח לא גדול מ25
                                                                If SpaceAfter + PPS < 25 Then
                                                
                                                                'מפעיל פקודת תיקון בלולאה *מס' פסקאות
                                                                 For P = 1 To Pcol2
                                            
                                                          'מוסיף רווח אחרי פסקה
                                                             With Selection
                                                            For B = 1 To .Paragraphs.Count
                                                             .Paragraphs(B).Format.SpaceAfter = .Paragraphs(B).Format.SpaceAfter + PPS
                                                              Next B
                                                            End With
                                           
                                            
                                                           'עבור לפסקה הבאה
                                                            Selection.MoveDown wdParagraph, 1
                                                                 Next P
                                             
                                                           'אחרת עורך טור 1
                                                                Else
                                                             If Pcol1 = 0 Then
                                                              'אחרת עובר עמוד
                                                              
                                                           Endcol2.Select
                                                           Selection.MoveDown wdParagraph, 1
                                                           
                                                           Else
                                                              ' PPS - מחלק הפרש בין פסקאות
                                                                 PPS = Acol / Pcol1
                                          
                                                              'עבור לשורה ראשונה בטור
                                                                    Startcol1.Select
                                          
                                                                'בודק אם רווח לא קטן מ2.5
                                                                If SpaceAfter - PPS > 2.5 Then
                                              
                                                                 'מפעיל פקודת תיקון בלולאה *מס' פסקאות
                                                              For P = 1 To Pcol1
                                           
                                                              'מקטין רווח אחרי פסקה
                                                                   With Selection
                                                                    For B = 1 To .Paragraphs.Count
                                                
                                                                      .Paragraphs(B).Format.SpaceAfter = .Paragraphs(B).Format.SpaceAfter - PPS
                                                                      Next B
                                                                          End With
                                              
                                                 
                                                                        'עבור לפסקה הבאה
                                                                    Selection.MoveDown wdParagraph, 1
                                                                        Next P
                                                               'אחרת עובר עמוד
                                                                Else
                                                                'עבור לפסקה הבאה
                                                               Endcol2.Select
                                                               Selection.MoveDown wdParagraph, 1
                                          
                                                                 End If
                                                                  End If
                                                    End If
                                                   
                                                
                                                           'אם טור 2 ארוך מ1
                                                            ElseIf col2 > col1 Then
                                                                 'בודק אם רווח לא קטן מ2.5
                                                                     If SpaceAfter - PPS > 2.5 Then
                                              
                                                                   'מפעיל פקודת תיקון בלולאה *מס' פסקאות
                                                                    For P = 1 To Pcol2
                                           
                                                                      'מקטין רווח אחרי פסקה
                                                                    With Selection
                                                                     For B = 1 To .Paragraphs.Count
                                                                     .Paragraphs(B).Format.SpaceAfter = .Paragraphs(B).Format.SpaceAfter - PPS
                                                                     Next B
                                                                    End With
                                            
                                            
                                                                   'עבור לפסקה הבאה
                                                                Selection.MoveDown wdParagraph, 1
                                                                    Next P
                                            
                                                                    'אחרת עורך טור 1
                                                                     Else
                                                  
                                                             If Pcol1 = 0 Then
                                                              'אחרת עובר עמוד
                                                              
                                                           Endcol2.Select
                                                           Selection.MoveDown wdParagraph, 1
                                                           
                                                           Else
                                                                      ' PPS - מחלק הפרש בין פסקאות
                                                                        PPS = Acol / Pcol1
                                          
                                                                           'עבור לשורה ראשונה בטור
                                                                            Startcol1.Select
                                            
                                                                           'בודק אם רווח לא  גדול מ25
                                                                              If SpaceAfter + PPS < 25 Then
                                                                               'מפעיל פקודת תיקון בלולאה *מס' פסקאות
                                                                                For P = 1 To Pcol1
                                           
                                                                              'מגדיל  רווח אחרי פסקה
                                                                               With Selection
                                                                                For B = 1 To .Paragraphs.Count
                                                
                                                                              .Paragraphs(B).Format.SpaceAfter = .Paragraphs(B).Format.SpaceAfter + PPS
                                                                                 Next B
                                                                              End With
                                                 
                                                                               'עבור לפסקה הבאה
                                                                                Selection.MoveDown wdParagraph, 1
                                                                                 Next P
                                               
                                                                                 'אחרת עובר עמוד
                                                                              Else
                                                                                 'עבור לפסקה הבאה
                                                                                   Endcol2.Select
                                                                                   Selection.MoveDown wdParagraph, 1
                                           
                                                                                End If
                                                                               End If
                                                                                End If
                                                             End If
                                                       End If
                                                 'עובר לעמודה הבאה
                                            Endcol2.Select
                                               Selection.MoveDown wdParagraph, 1
                                          
                                             
                                                End If
                                          
                                                'עובר לעמודה הבאה
                                            Endcol2.Select
                                               Selection.MoveDown wdParagraph, 1
                                          
                                             
                                             
                                             
                                             Application.ScreenUpdating = True
                                          End Sub
                                          
                                          
                                          

                                          ושאר הקודים בקובץ המצ"ב

                                          menajemmendelM מנותק
                                          menajemmendelM מנותק
                                          menajemmendel
                                          כתב ב נערך לאחרונה על ידי
                                          #37

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

                                          תודה

                                          תגובה 1 תגובה אחרונה
                                          1

                                          • התחברות

                                          • אין לך חשבון עדיין? הרשמה

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