דילוג לתוכן
  • חוקי הפורום
  • פופולרי
  • לא נפתר
  • משתמשים
  • חיפוש גוגל בפורום
  • צור קשר
עיצובים
  • 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 עוקבים
  • מהישן לחדש
  • מהחדש לישן
  • הכי הרבה הצבעות
תגובה
  • תגובה כנושא
התחברו כדי לפרסם תגובה
נושא זה נמחק. רק משתמשים עם הרשאות מתאימות יוכלו לצפות בו.
  • 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
                              • ר רפרם ב"ר פפא

                                בסייעתא דשמיא
                                עדכון המאקרו יישור טורים - תוספות ותיקונים
                                בהמשך להערות וההארות שנכתבו בשרשור זה בסייעתא דשמיא הנני להציע לציבור היקר את מאקרו יישור טורים גרסה 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
                                כתב ב נערך לאחרונה על ידי menajemmendel
                                #38

                                @רפרם-ב-ר-פפא
                                שוב תודה על תודה רבה על כל העבודה והמאמצים והכל בחינם, תודה, אצלי עובד טוב כל עוד שתחילת הטור הבא אין כותרות משנה (שהם עצמם גם בשתי טורים) אבל כשיש כותרת שם כזה: 027d1f10-f24e-4d05-9135-ebce59972c8d-image.png
                                לא מתקן את זה (אני יודע, שזה בעיה מסוג אחר, שאין מספיק מקום להכניס את הכותרת שצמודה לפסקה הבא וכו') אני רק שואל אם אמור לפתור גם כאלה דברים.

                                והנה עוד שאלה/בקשה: אני מנסה לכתוב מאקרו ליישור טורים בעצמי (אני רוצה בעצמי כמה סיבות, אחד כי אני מתלמד בVBA ושתיים כי אני מעדיף להשתמש בפקודות שאני כתבתי, שהם יותר ברורים לי, אני יודע מה בדיוק הם עושים ולמה, ומה המגבלות שלהם, ולשנות אותם לפי הצורך, אבל כאן אני נתקתי בחלק היצירתי, לא בחלק של הקידוד, דהיינו אם הייתי עושה את זה ידני, מה הייתי מנסה לעשות.
                                אז אבקש אם זה לא טירחה גדולה, האם אתה יכול להסביר לי מה בדיוק אתה מנסה לעשות עם הקוד שלך, שמה יעשה ולפי איזה פרמטרים , ניסיתי לעבור עליו כבר כמה וכמה פעמים, (כמה ימים) ואני נאבד שם, מה בדיוק אתה רוצה לעשות, כלומר אני לא שואל על חלק של התיכנות, זה אני כבר אסתדר איך לכתוב אותו, אבל מה אתה רוצה לצוות למחשב שיעשה, שימדוד הפרשים ואז מה, איך יפתור את הבעיה, יפזר אותו בין השורות, או בין הפסיקאות, או מה,
                                אשמח אם תוכל לפרט לי, (שוב אני לא צריך שתסביר את כל קוד) תודה

                                תגובה 1 תגובה אחרונה
                                1
                                • האדם החושבה האדם החושב

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

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

                                  @האדם-החושב הקודים מיועדים להכניס לתבנית שלך או לתבנית ראשית אם אתה לא רוצה להוריד את כל התבנית וכן ללמידה
                                  @menajemmendel א. אצלי עובד גם בפעם ראשונה ותודה על ההארה אבדוק את זה בעזר ה' אם אתה יכול להגדיר בדיוק מה הבעיה אם הוא בכל מסמך או כמות פסקאות וכן כותרות וכו' ב. יישור כל המסמך עורך טורים הוא פקודה פנימית מתוך הראשי שמפעיל אם צריך לערוך ג. אפשר שכיוון שהוא הפרש גדול מידי לא יכול לחלק במגבלת המינימום והמקסימום הפתרון לכאורה לבטל בקרת שורות מיותמות (לא הכנסתי למאקרו שעדיף לא להגיע לזה ולערוך ידנית כמו מרווח בין מילים או שורות במקרה של בעיה כי אינו משהו בנראות ) ולאחר מכן להפעיל שוב
                                  ד. לתועלת הציבור אפרט בקצרה מה המאקרו עושה תחילה מגדיר איפה מתחיל טור (דהיינו תחילת שני טורים ועוצר במקום שיש לפניה כותרת על טור בודד)וכן סוף שני טורים ולאחר מכן מגדיר גובה כל אחד מהם וממילא ההפרש ולאחר שקיבל את ההפרש אם אינו ישר בודק באיזה טור יש יותר פסקאות (וזה לצורך הנראות) ועורך את הטור רב הפסקאות מחלק את ההפרש בין הפסקאות (-1 שהוא הסוף שעובר לעמוד הבא) ומפעיל לולאה כפול מספר פסקאות ומוסיף את התוצאה לכל פסקא וכמו כן לפני כן בודק אם התוצאה של המרווח לא תהיה מעל 25 או מתחת2.5 ואם כן מנסה לערוך את הטור השני (שהוא אינו רב בפסקאות) ואם גם שם לא עומד בכללים שנקבעו מדלג לעמוד הבא או מודיע שאינו עומד בקרטיונים
                                  נ.ב. בענין המגבלת טווח ניתן לערוך ידנית למי שמבין קצת בVBA לחפש איפה כתוב 2.5 או25 ולשנות לרצוי מקווה בעזרת ה' שבקרוב יהיה טופס מסודר להגדיר טווח
                                  בתקווה שעזרתי והועלתי לכולם

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

                                    @האדם-החושב הקודים מיועדים להכניס לתבנית שלך או לתבנית ראשית אם אתה לא רוצה להוריד את כל התבנית וכן ללמידה
                                    @menajemmendel א. אצלי עובד גם בפעם ראשונה ותודה על ההארה אבדוק את זה בעזר ה' אם אתה יכול להגדיר בדיוק מה הבעיה אם הוא בכל מסמך או כמות פסקאות וכן כותרות וכו' ב. יישור כל המסמך עורך טורים הוא פקודה פנימית מתוך הראשי שמפעיל אם צריך לערוך ג. אפשר שכיוון שהוא הפרש גדול מידי לא יכול לחלק במגבלת המינימום והמקסימום הפתרון לכאורה לבטל בקרת שורות מיותמות (לא הכנסתי למאקרו שעדיף לא להגיע לזה ולערוך ידנית כמו מרווח בין מילים או שורות במקרה של בעיה כי אינו משהו בנראות ) ולאחר מכן להפעיל שוב
                                    ד. לתועלת הציבור אפרט בקצרה מה המאקרו עושה תחילה מגדיר איפה מתחיל טור (דהיינו תחילת שני טורים ועוצר במקום שיש לפניה כותרת על טור בודד)וכן סוף שני טורים ולאחר מכן מגדיר גובה כל אחד מהם וממילא ההפרש ולאחר שקיבל את ההפרש אם אינו ישר בודק באיזה טור יש יותר פסקאות (וזה לצורך הנראות) ועורך את הטור רב הפסקאות מחלק את ההפרש בין הפסקאות (-1 שהוא הסוף שעובר לעמוד הבא) ומפעיל לולאה כפול מספר פסקאות ומוסיף את התוצאה לכל פסקא וכמו כן לפני כן בודק אם התוצאה של המרווח לא תהיה מעל 25 או מתחת2.5 ואם כן מנסה לערוך את הטור השני (שהוא אינו רב בפסקאות) ואם גם שם לא עומד בכללים שנקבעו מדלג לעמוד הבא או מודיע שאינו עומד בקרטיונים
                                    נ.ב. בענין המגבלת טווח ניתן לערוך ידנית למי שמבין קצת בVBA לחפש איפה כתוב 2.5 או25 ולשנות לרצוי מקווה בעזרת ה' שבקרוב יהיה טופס מסודר להגדיר טווח
                                    בתקווה שעזרתי והועלתי לכולם

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

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

                                    תגובה 1 תגובה אחרונה
                                    1
                                    • A מנותק
                                      A מנותק
                                      ASDF1345
                                      כתב ב נערך לאחרונה על ידי
                                      #41

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

                                      ר תגובה 1 תגובה אחרונה
                                      0
                                      • A ASDF1345

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

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

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

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

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

                                          P מנותק
                                          P מנותק
                                          pcinfogmach
                                          מדריכים
                                          כתב ב נערך לאחרונה על ידי
                                          #43
                                          פוסט זה נמחק!
                                          תגובה 1 תגובה אחרונה
                                          0
                                          • האדם החושבה האדם החושב התייחס לנושא זה ב

                                          • התחברות

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

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