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

עזרה | מישהו יכול לבדוק לי את המאקרו יישור טורים דלהלן

מתוזמן נעוץ נעול הועבר עזרה הדדית - וורד
29 פוסטים 5 כותבים 459 צפיות 6 עוקבים
  • מהישן לחדש
  • מהחדש לישן
  • הכי הרבה הצבעות
תגובה
  • תגובה כנושא
התחברו כדי לפרסם תגובה
נושא זה נמחק. רק משתמשים עם הרשאות מתאימות יוכלו לצפות בו.
  • P pcinfogmach

    @יאיר-הבהיר כתב בעזרה | מישהו יכול לבדוק לי את המאקרו יישור טורים דלהלן:

    @pcinfogmach ניסיתי גם בלי קיפול ספר ועדיין לא עובד לי...

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

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

    @pcinfogmach כתב בעזרה | מישהו יכול לבדוק לי את המאקרו יישור טורים דלהלן:

    @יאיר-הבהיר כתב בעזרה | מישהו יכול לבדוק לי את המאקרו יישור טורים דלהלן:

    @pcinfogmach ניסיתי גם בלי קיפול ספר ועדיין לא עובד לי...

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

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

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

      מצו"ב מאקרו חדש ליישור טורים בוורד עבור התוסף לוורד עיצוב תורני אשמח אם מישהו יוכל לבדוק לי את הביצועים שלו

      Option Explicit
      Dim currentPageNumber As Long
       
      Sub AlignColumnsInSelection()
          Dim originalRange As range
          Dim currentPageRange As range, currentSectionRange As range
          Dim startPageNumber As Long, endPageNumber As Long
          Dim currentSection As Section
          
          On Error GoTo errorHandle ' Enable error handling.
          Application.UndoRecord.StartCustomRecord "ééùåø èåøéí"
          
          ' Save the initial selection range to restore it after alignment.
          Set originalRange = Selection.range
          ExpandSelectionToEndOfPageOrSection originalRange
          
          ' Get the first and last page numbers within the selection.
          startPageNumber = originalRange.Characters.First.Information(wdActiveEndPageNumber)
          endPageNumber = originalRange.Characters.Last.Information(wdActiveEndPageNumber)
          
          ' Loop through each page within the selection.
          For currentPageNumber = startPageNumber To endPageNumber
              ' Navigate to the current page.
              Selection.GoTo What:=wdGoToPage, Which:=wdGoToAbsolute, Name:=currentPageNumber
              Application.ScreenUpdating = False ' Turn off screen updating for better performance.
          
              ' Select the entire content of the current page.
              Set currentPageRange = Selection.Bookmarks("\page").range
              
              ' Process sections within the page, if applicable.
              If currentPageRange.Sections.Count > 1 Then
                  For Each currentSection In currentPageRange.Sections
                      Set currentSectionRange = currentSection.range
                      ' Adjust the section range based on the page number.
                      If currentSectionRange.Characters.First.Information(wdActiveEndPageNumber) = currentPageNumber Then
                          currentSectionRange.End = currentPageRange.End
                      ElseIf currentSectionRange.Characters.First.Information(wdActiveEndPageNumber) < currentPageNumber Then
                          currentSectionRange.Start = currentPageRange.Start
                      End If
                      
                      ' Align the section if it has two text columns.
                      If currentSectionRange.PageSetup.TextColumns.Count = 2 And currentSectionRange.InRange(originalRange) Then
                          DoAlignment currentSectionRange
                      End If
                  Next currentSection
                  
              ElseIf currentPageRange.PageSetup.TextColumns.Count = 2 Then
                  ' Align the page if there is only one section.
                  DoAlignment currentPageRange
              End If
              
              Application.ScreenUpdating = True 'Re-enable screen updating for visual progress.
              DoEvents ' Allow system events to process to avoid freezing.
          Next currentPageNumber
          
          ' Restore the original selection.
          originalRange.Select
          
          ' End the custom undo record
          Application.UndoRecord.EndCustomRecord
          
          Exit Sub
       
      errorHandle:
      Call ErrorHandler
      End Sub
      Sub ExpandSelectionToEndOfPageOrSection(ByRef originalRange As range)
          ' Declare variables to hold the start and end positions of sections and pages
          Dim endSection, startSection As Long
          Dim endPage, startPage As Long
          
          ' Get the end position of the last section and the start position of the first section in the range
          endSection = originalRange.Sections.Last.range.End
          startSection = originalRange.Sections.First.range.Start
       
          ' Get the page number where the range ends and where it starts
          endPage = originalRange.Characters.Last.Information(wdActiveEndPageNumber)
          startPage = originalRange.Characters.First.Information(wdActiveEndPageNumber)
          
          ' Move the selection to the end page and get the end position of that page
          Selection.GoTo What:=wdGoToPage, Which:=wdGoToAbsolute, Name:=endPage
          endPage = Selection.Bookmarks("\page").End
          
          ' Move the selection to the start page and get the start position of that page
          Selection.GoTo What:=wdGoToPage, Which:=wdGoToAbsolute, Name:=startPage
          startPage = Selection.Start
          
          ' Extend the range's end position to the end of the section or page, whichever comes first
          If endSection < endPage Then
              If originalRange.End < endSection Then originalRange.End = endSection
          Else
              If originalRange.End < endPage Then originalRange.End = endPage
          End If
          
          ' Extend the range's start position to the start of the section or page, whichever comes last
          If startSection > startPage Then
              If originalRange.Start > startSection Then originalRange.Start = startSection
          Else
              If originalRange.Start > startPage Then originalRange.Start = startPage
          End If
      End Sub
       
       
       
      Sub DoAlignment(ActionRange As range)
          
          Dim firstColumnRange, secondColumnRange As range ' Declare variables for the ranges representing the two columns.
          Dim columnBoundaryX, column1BoundaryY, column2BoundaryY As Double ' Variables to store the column boundary and vertical positions of the columns.
          Dim positionDifference As Single ' Stores the difference in vertical positions to adjust spacing between paragraphs.
          Dim firstColumnBottomMarker, secondColumnBottomMarker As range ' Variables to mark the bottom of each column.
          Dim currentParagraph As Paragraph ' Variable to iterate through the paragraphs.
              
          On Error GoTo errorHandle
          ' Duplicate the selected range to represent the first and second columns.
          Set firstColumnRange = ActionRange.Duplicate
          Set secondColumnRange = ActionRange.Duplicate
          
          ' Determine the column boundary using the horizontal position on the page.
          ActionRange.Select
          With Selection
              .EndKey ' Move the cursor to the end of the selection.
              .HomeKey ' Move the cursor back to the start of the selection.
               columnBoundaryX = .Information(wdHorizontalPositionRelativeToPage) + (.PageSetup.TextColumns(1).SpaceAfter) ' Set the boundary between the columns.
              Set secondColumnBottomMarker = .range ' Store the bottom position of the second column.
          End With
          
          ' Configure the first column range.
          With firstColumnRange
              .Collapse ' Collapse the range to its starting point.
       
              ' Expand the first column range to include paragraphs until it reaches the column boundary.
              Do While .Next(wdParagraph).Characters.Last.Information(wdHorizontalPositionRelativeToPage) > columnBoundaryX
                  .MoveEnd wdParagraph, 1 ' Extend the range by one paragraph.
              Loop
              
              ' Fine-tune the boundary by moving character by character until it reaches the column boundary.
              Do While .Next.Information(wdHorizontalPositionRelativeToPage) > columnBoundaryX
                       .MoveEnd wdCharacter, 1 ' Extend the range by one character.
              Loop
       
              secondColumnRange.Start = .End
          End With
          
          ' Select the first column range to capture its bottom position.
          firstColumnRange.Select
          With Selection
              .EndKey ' Move to the end of the first column.
              .HomeKey ' Move back to the start.
          End With
          Set firstColumnBottomMarker = Selection.range ' Store the bottom position of the first column.
          
          ' Retrieve the vertical positions of the bottom markers for both columns.
          column1BoundaryY = firstColumnBottomMarker.Information(wdVerticalPositionRelativeToPage)
          column2BoundaryY = secondColumnBottomMarker.Information(wdVerticalPositionRelativeToPage)
          
          ' Adjust spacing between paragraphs to align the bottoms of both columns.
          ' This loop increases spacing if the first column is shorter.
          Do While column2BoundaryY > column1BoundaryY
              ' Calculate the difference in vertical positions, divided by the number of paragraphs.
              positionDifference = (column2BoundaryY - column1BoundaryY) / firstColumnRange.Paragraphs.Count
              
              ' Exit if the difference is too large or negative.
              If positionDifference > 40 Or positionDifference < 0 Then Exit Do
              
              ' Increase the spacing after each paragraph in the first column.
              For Each currentParagraph In firstColumnRange.Paragraphs
                  If currentParagraph.range.Characters.Last.InRange(firstColumnRange) Then
                      currentParagraph.SpaceAfter = currentParagraph.SpaceAfter + positionDifference
                      ' Update the bottom position of the first column.
                       column1BoundaryY = firstColumnBottomMarker.Information(wdVerticalPositionRelativeToPage)
                      ' Exit the loop if the bottom of the first column aligns with the second column.
                      If column1BoundaryY >= column2BoundaryY Then
                          Exit For
                      End If
                  End If
              Next currentParagraph
                 
          Loop
          
          ' If the second column is shorter, adjust its paragraph spacing similarly.
          Do While column1BoundaryY > column2BoundaryY
              ' Calculate the spacing difference for the second column.
              positionDifference = (column1BoundaryY - column2BoundaryY) / secondColumnRange.Paragraphs.Count
              
              ' Exit if the difference is too large.
              If positionDifference > 40 Then Exit Do
              
              ' Increase the spacing after each paragraph in the second column.
              For Each currentParagraph In secondColumnRange.Paragraphs
                  If currentParagraph.range.Characters.Last.InRange(secondColumnRange) Then
                      currentParagraph.range.Select
                      currentParagraph.SpaceAfter = currentParagraph.SpaceAfter + positionDifference
                      ' Update the bottom position of the second column.
                      column2BoundaryY = secondColumnBottomMarker.Information(wdVerticalPositionRelativeToPage)
                      ' Exit the loop if the second column aligns with the first column.
                      If column2BoundaryY >= column1BoundaryY Then Exit For
                  End If
              Next currentParagraph
              
          Loop
          
      Exit Sub
      errorHandle:
      Call ErrorHandler
      End Sub
       
      Sub ErrorHandler()
          ' Handle errors and clean up.
          Application.UndoRecord.EndCustomRecord
          Application.ScreenUpdating = True
          
          Dim msg As String
          Debug.Print "Error Number: " & Err.Number & vbCrLf & _
                "Source: " & Err.Source & vbCrLf & _
                "Description: " & Err.Description & vbCrLf & _
                "Help Context: " & Err.HelpContext & vbCrLf & _
                "Help File: " & Err.HelpFile & vbCrLf & _
                "Page Number: " & currentPageNumber
      End Sub
      
      
      S מנותק
      S מנותק
      shishko
      כתב נערך לאחרונה על ידי
      #15

      @pcinfogmach סתם שאלה בקשר לתוסף אולי כדאי לייצר הדגשת מילה ראשונה דרך האפשרות בסינית לשתי שורות באותה שורה, ניסית פעם?

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

        @pcinfogmach סתם שאלה בקשר לתוסף אולי כדאי לייצר הדגשת מילה ראשונה דרך האפשרות בסינית לשתי שורות באותה שורה, ניסית פעם?

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

        @shishko
        לא ניסיתי. אתה ניסית והצליח?

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

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

          @shishko
          לא ניסיתי. אתה ניסית והצליח?

          S מנותק
          S מנותק
          shishko
          כתב נערך לאחרונה על ידי shishko
          #17

          @pcinfogmach לא, בדיוק לפני כמה דקות חשבתי על זה באופן ידני ודאי ניתן לעשות את זה על אף א"א לעשות יישור לסוף השורה ולכן ישנם אי אלו הבדלים חסרון נוסף שניתן לעשו שני שורות רק עם רווח ביניהם של נקודה 1 ולא 1.5 כמו הגדרת ברירת המחדל השאלה אם אין דרך להתגבר על זה?
          וגם אם לא אולי ניתן לעשות את זה כאפשרות נוספת כשהמעלה שהמילה הראשונה היא חלק מהטקסט ויותר קל לבטל את זה במיקום מסויים!!
          צריך לבדוק אם אפשר בעיקרון להשתמש בזה גם כשאין סינית על המחשב וכל הבעיה שטכנית זה לא מופיע (דרך אגב אם כן אפשר להוסיף את האפשרויות שיש בסינית לתוסף).
          אם יהיה לי זמן אני ינסה לעבוד על זה.

          P תגובה 1 תגובה אחרונה
          2
          • S shishko

            @pcinfogmach לא, בדיוק לפני כמה דקות חשבתי על זה באופן ידני ודאי ניתן לעשות את זה על אף א"א לעשות יישור לסוף השורה ולכן ישנם אי אלו הבדלים חסרון נוסף שניתן לעשו שני שורות רק עם רווח ביניהם של נקודה 1 ולא 1.5 כמו הגדרת ברירת המחדל השאלה אם אין דרך להתגבר על זה?
            וגם אם לא אולי ניתן לעשות את זה כאפשרות נוספת כשהמעלה שהמילה הראשונה היא חלק מהטקסט ויותר קל לבטל את זה במיקום מסויים!!
            צריך לבדוק אם אפשר בעיקרון להשתמש בזה גם כשאין סינית על המחשב וכל הבעיה שטכנית זה לא מופיע (דרך אגב אם כן אפשר להוסיף את האפשרויות שיש בסינית לתוסף).
            אם יהיה לי זמן אני ינסה לעבוד על זה.

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

            @shishko
            אוקיי תעדכן אותי
            ואם תוכל לשלוח לי מאקרו מוכן כמובן הדבר יקל עלי

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

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

              @יאיר-הבהיר כתב בעזרה | מישהו יכול לבדוק לי את המאקרו יישור טורים דלהלן:

              [צריך שיוגדר לו מעבר מקטע מיד בסוף הטקסט, ואז הוא מתיישר כמעט בכל המקרים]

              לא כל כך הבנתי את בקשתך האחרונה סרטון קצר מאוד יעזור

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

              @pcinfogmach כתב בעזרה | מישהו יכול לבדוק לי את המאקרו יישור טורים דלהלן:

              @יאיר-הבהיר כתב בעזרה | מישהו יכול לבדוק לי את המאקרו יישור טורים דלהלן:

              [צריך שיוגדר לו מעבר מקטע מיד בסוף הטקסט, ואז הוא מתיישר כמעט בכל המקרים]

              לא כל כך הבנתי את בקשתך האחרונה סרטון קצר מאוד יעזור

              ffc2cf7d-3590-4dc3-8af9-c20a05afa16f-bandicam 2024-10-27 01-45-12-677.mp4

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

                @pcinfogmach כתב בעזרה | מישהו יכול לבדוק לי את המאקרו יישור טורים דלהלן:

                @יאיר-הבהיר כתב בעזרה | מישהו יכול לבדוק לי את המאקרו יישור טורים דלהלן:

                @pcinfogmach ניסיתי גם בלי קיפול ספר ועדיין לא עובד לי...

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

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

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

                @יאיר-הבהיר
                מצאתי שגיאה בקוד שלי אנא נסה כעת בקוד המעודכן

                עריכה:
                ערכתי עוד כמה דברים בקוד כעת הוא אמור לעבוד גם בקבצים עם קיפול
                בדקתי ועבד אצלי על הקובץ שהעלית

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

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

                  @pcinfogmach כתב בעזרה | מישהו יכול לבדוק לי את המאקרו יישור טורים דלהלן:

                  @יאיר-הבהיר כתב בעזרה | מישהו יכול לבדוק לי את המאקרו יישור טורים דלהלן:

                  [צריך שיוגדר לו מעבר מקטע מיד בסוף הטקסט, ואז הוא מתיישר כמעט בכל המקרים]

                  לא כל כך הבנתי את בקשתך האחרונה סרטון קצר מאוד יעזור

                  ffc2cf7d-3590-4dc3-8af9-c20a05afa16f-bandicam 2024-10-27 01-45-12-677.mp4

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

                  @יאיר-הבהיר
                  קבצים מסוג זה נחסמים בנטפרי אשמח אם תשלח לי במייל בתוך קובץ זיפ

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

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

                    @יאיר-הבהיר
                    מצאתי שגיאה בקוד שלי אנא נסה כעת בקוד המעודכן

                    עריכה:
                    ערכתי עוד כמה דברים בקוד כעת הוא אמור לעבוד גם בקבצים עם קיפול
                    בדקתי ועבד אצלי על הקובץ שהעלית

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

                    @pcinfogmach כתב בעזרה | מישהו יכול לבדוק לי את המאקרו יישור טורים דלהלן:

                    @יאיר-הבהיר
                    מצאתי שגיאה בקוד שלי אנא נסה כעת בקוד המעודכן

                    עריכה:
                    ערכתי עוד כמה דברים בקוד כעת הוא אמור לעבוד גם בקבצים עם קיפול
                    בדקתי ועבד אצלי על הקובץ שהעלית

                    עכשיו זה באמת עבד לי מצוין, רק שתי הארות:

                    1. לפעמים נוצרים רווחים גדולים מדי שלא נצרכים בשביל היישור הפשוט.
                    2. אם אחרי שהוא יישר את הטור הימני פתאום עברה שורה מהטור השמאלי לעמוד הבא [מאיזו סיבה שלא תהיה] - נראה לי שהוא לא קולט את זה...

                    בהצלחה!

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

                      @pcinfogmach כתב בעזרה | מישהו יכול לבדוק לי את המאקרו יישור טורים דלהלן:

                      @יאיר-הבהיר
                      מצאתי שגיאה בקוד שלי אנא נסה כעת בקוד המעודכן

                      עריכה:
                      ערכתי עוד כמה דברים בקוד כעת הוא אמור לעבוד גם בקבצים עם קיפול
                      בדקתי ועבד אצלי על הקובץ שהעלית

                      עכשיו זה באמת עבד לי מצוין, רק שתי הארות:

                      1. לפעמים נוצרים רווחים גדולים מדי שלא נצרכים בשביל היישור הפשוט.
                      2. אם אחרי שהוא יישר את הטור הימני פתאום עברה שורה מהטור השמאלי לעמוד הבא [מאיזו סיבה שלא תהיה] - נראה לי שהוא לא קולט את זה...

                      בהצלחה!

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

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

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

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

                        מצו"ב מאקרו חדש ליישור טורים בוורד עבור התוסף לוורד עיצוב תורני אשמח אם מישהו יוכל לבדוק לי את הביצועים שלו

                        Option Explicit
                        Dim currentPageNumber As Long
                         
                        Sub AlignColumnsInSelection()
                            Dim originalRange As range
                            Dim currentPageRange As range, currentSectionRange As range
                            Dim startPageNumber As Long, endPageNumber As Long
                            Dim currentSection As Section
                            
                            On Error GoTo errorHandle ' Enable error handling.
                            Application.UndoRecord.StartCustomRecord "ééùåø èåøéí"
                            
                            ' Save the initial selection range to restore it after alignment.
                            Set originalRange = Selection.range
                            ExpandSelectionToEndOfPageOrSection originalRange
                            
                            ' Get the first and last page numbers within the selection.
                            startPageNumber = originalRange.Characters.First.Information(wdActiveEndPageNumber)
                            endPageNumber = originalRange.Characters.Last.Information(wdActiveEndPageNumber)
                            
                            ' Loop through each page within the selection.
                            For currentPageNumber = startPageNumber To endPageNumber
                                ' Navigate to the current page.
                                Selection.GoTo What:=wdGoToPage, Which:=wdGoToAbsolute, Name:=currentPageNumber
                                Application.ScreenUpdating = False ' Turn off screen updating for better performance.
                            
                                ' Select the entire content of the current page.
                                Set currentPageRange = Selection.Bookmarks("\page").range
                                
                                ' Process sections within the page, if applicable.
                                If currentPageRange.Sections.Count > 1 Then
                                    For Each currentSection In currentPageRange.Sections
                                        Set currentSectionRange = currentSection.range
                                        ' Adjust the section range based on the page number.
                                        If currentSectionRange.Characters.First.Information(wdActiveEndPageNumber) = currentPageNumber Then
                                            currentSectionRange.End = currentPageRange.End
                                        ElseIf currentSectionRange.Characters.First.Information(wdActiveEndPageNumber) < currentPageNumber Then
                                            currentSectionRange.Start = currentPageRange.Start
                                        End If
                                        
                                        ' Align the section if it has two text columns.
                                        If currentSectionRange.PageSetup.TextColumns.Count = 2 And currentSectionRange.InRange(originalRange) Then
                                            DoAlignment currentSectionRange
                                        End If
                                    Next currentSection
                                    
                                ElseIf currentPageRange.PageSetup.TextColumns.Count = 2 Then
                                    ' Align the page if there is only one section.
                                    DoAlignment currentPageRange
                                End If
                                
                                Application.ScreenUpdating = True 'Re-enable screen updating for visual progress.
                                DoEvents ' Allow system events to process to avoid freezing.
                            Next currentPageNumber
                            
                            ' Restore the original selection.
                            originalRange.Select
                            
                            ' End the custom undo record
                            Application.UndoRecord.EndCustomRecord
                            
                            Exit Sub
                         
                        errorHandle:
                        Call ErrorHandler
                        End Sub
                        Sub ExpandSelectionToEndOfPageOrSection(ByRef originalRange As range)
                            ' Declare variables to hold the start and end positions of sections and pages
                            Dim endSection, startSection As Long
                            Dim endPage, startPage As Long
                            
                            ' Get the end position of the last section and the start position of the first section in the range
                            endSection = originalRange.Sections.Last.range.End
                            startSection = originalRange.Sections.First.range.Start
                         
                            ' Get the page number where the range ends and where it starts
                            endPage = originalRange.Characters.Last.Information(wdActiveEndPageNumber)
                            startPage = originalRange.Characters.First.Information(wdActiveEndPageNumber)
                            
                            ' Move the selection to the end page and get the end position of that page
                            Selection.GoTo What:=wdGoToPage, Which:=wdGoToAbsolute, Name:=endPage
                            endPage = Selection.Bookmarks("\page").End
                            
                            ' Move the selection to the start page and get the start position of that page
                            Selection.GoTo What:=wdGoToPage, Which:=wdGoToAbsolute, Name:=startPage
                            startPage = Selection.Start
                            
                            ' Extend the range's end position to the end of the section or page, whichever comes first
                            If endSection < endPage Then
                                If originalRange.End < endSection Then originalRange.End = endSection
                            Else
                                If originalRange.End < endPage Then originalRange.End = endPage
                            End If
                            
                            ' Extend the range's start position to the start of the section or page, whichever comes last
                            If startSection > startPage Then
                                If originalRange.Start > startSection Then originalRange.Start = startSection
                            Else
                                If originalRange.Start > startPage Then originalRange.Start = startPage
                            End If
                        End Sub
                         
                         
                         
                        Sub DoAlignment(ActionRange As range)
                            
                            Dim firstColumnRange, secondColumnRange As range ' Declare variables for the ranges representing the two columns.
                            Dim columnBoundaryX, column1BoundaryY, column2BoundaryY As Double ' Variables to store the column boundary and vertical positions of the columns.
                            Dim positionDifference As Single ' Stores the difference in vertical positions to adjust spacing between paragraphs.
                            Dim firstColumnBottomMarker, secondColumnBottomMarker As range ' Variables to mark the bottom of each column.
                            Dim currentParagraph As Paragraph ' Variable to iterate through the paragraphs.
                                
                            On Error GoTo errorHandle
                            ' Duplicate the selected range to represent the first and second columns.
                            Set firstColumnRange = ActionRange.Duplicate
                            Set secondColumnRange = ActionRange.Duplicate
                            
                            ' Determine the column boundary using the horizontal position on the page.
                            ActionRange.Select
                            With Selection
                                .EndKey ' Move the cursor to the end of the selection.
                                .HomeKey ' Move the cursor back to the start of the selection.
                                 columnBoundaryX = .Information(wdHorizontalPositionRelativeToPage) + (.PageSetup.TextColumns(1).SpaceAfter) ' Set the boundary between the columns.
                                Set secondColumnBottomMarker = .range ' Store the bottom position of the second column.
                            End With
                            
                            ' Configure the first column range.
                            With firstColumnRange
                                .Collapse ' Collapse the range to its starting point.
                         
                                ' Expand the first column range to include paragraphs until it reaches the column boundary.
                                Do While .Next(wdParagraph).Characters.Last.Information(wdHorizontalPositionRelativeToPage) > columnBoundaryX
                                    .MoveEnd wdParagraph, 1 ' Extend the range by one paragraph.
                                Loop
                                
                                ' Fine-tune the boundary by moving character by character until it reaches the column boundary.
                                Do While .Next.Information(wdHorizontalPositionRelativeToPage) > columnBoundaryX
                                         .MoveEnd wdCharacter, 1 ' Extend the range by one character.
                                Loop
                         
                                secondColumnRange.Start = .End
                            End With
                            
                            ' Select the first column range to capture its bottom position.
                            firstColumnRange.Select
                            With Selection
                                .EndKey ' Move to the end of the first column.
                                .HomeKey ' Move back to the start.
                            End With
                            Set firstColumnBottomMarker = Selection.range ' Store the bottom position of the first column.
                            
                            ' Retrieve the vertical positions of the bottom markers for both columns.
                            column1BoundaryY = firstColumnBottomMarker.Information(wdVerticalPositionRelativeToPage)
                            column2BoundaryY = secondColumnBottomMarker.Information(wdVerticalPositionRelativeToPage)
                            
                            ' Adjust spacing between paragraphs to align the bottoms of both columns.
                            ' This loop increases spacing if the first column is shorter.
                            Do While column2BoundaryY > column1BoundaryY
                                ' Calculate the difference in vertical positions, divided by the number of paragraphs.
                                positionDifference = (column2BoundaryY - column1BoundaryY) / firstColumnRange.Paragraphs.Count
                                
                                ' Exit if the difference is too large or negative.
                                If positionDifference > 40 Or positionDifference < 0 Then Exit Do
                                
                                ' Increase the spacing after each paragraph in the first column.
                                For Each currentParagraph In firstColumnRange.Paragraphs
                                    If currentParagraph.range.Characters.Last.InRange(firstColumnRange) Then
                                        currentParagraph.SpaceAfter = currentParagraph.SpaceAfter + positionDifference
                                        ' Update the bottom position of the first column.
                                         column1BoundaryY = firstColumnBottomMarker.Information(wdVerticalPositionRelativeToPage)
                                        ' Exit the loop if the bottom of the first column aligns with the second column.
                                        If column1BoundaryY >= column2BoundaryY Then
                                            Exit For
                                        End If
                                    End If
                                Next currentParagraph
                                   
                            Loop
                            
                            ' If the second column is shorter, adjust its paragraph spacing similarly.
                            Do While column1BoundaryY > column2BoundaryY
                                ' Calculate the spacing difference for the second column.
                                positionDifference = (column1BoundaryY - column2BoundaryY) / secondColumnRange.Paragraphs.Count
                                
                                ' Exit if the difference is too large.
                                If positionDifference > 40 Then Exit Do
                                
                                ' Increase the spacing after each paragraph in the second column.
                                For Each currentParagraph In secondColumnRange.Paragraphs
                                    If currentParagraph.range.Characters.Last.InRange(secondColumnRange) Then
                                        currentParagraph.range.Select
                                        currentParagraph.SpaceAfter = currentParagraph.SpaceAfter + positionDifference
                                        ' Update the bottom position of the second column.
                                        column2BoundaryY = secondColumnBottomMarker.Information(wdVerticalPositionRelativeToPage)
                                        ' Exit the loop if the second column aligns with the first column.
                                        If column2BoundaryY >= column1BoundaryY Then Exit For
                                    End If
                                Next currentParagraph
                                
                            Loop
                            
                        Exit Sub
                        errorHandle:
                        Call ErrorHandler
                        End Sub
                         
                        Sub ErrorHandler()
                            ' Handle errors and clean up.
                            Application.UndoRecord.EndCustomRecord
                            Application.ScreenUpdating = True
                            
                            Dim msg As String
                            Debug.Print "Error Number: " & Err.Number & vbCrLf & _
                                  "Source: " & Err.Source & vbCrLf & _
                                  "Description: " & Err.Description & vbCrLf & _
                                  "Help Context: " & Err.HelpContext & vbCrLf & _
                                  "Help File: " & Err.HelpFile & vbCrLf & _
                                  "Page Number: " & currentPageNumber
                        End Sub
                        
                        
                        מ מנותק
                        מ מנותק
                        מאקרו
                        כתב נערך לאחרונה על ידי
                        #24

                        @pcinfogmach דבר ראשון כל הכבוד על ההשקעה!!!
                        שנית, קיבלתי את השגיאה הזאת:
                        1e6f77b9-f2c9-4caa-a54e-9988bf2477f4-image.png
                        כנראה שלא הגדרת משתנים גלובליים.
                        עדיין לא בדקתי מה הסיבה שהקוד קפץ ל-ErrorHandler.

                        מ תגובה 1 תגובה אחרונה
                        1
                        • מ מאקרו

                          @pcinfogmach דבר ראשון כל הכבוד על ההשקעה!!!
                          שנית, קיבלתי את השגיאה הזאת:
                          1e6f77b9-f2c9-4caa-a54e-9988bf2477f4-image.png
                          כנראה שלא הגדרת משתנים גלובליים.
                          עדיין לא בדקתי מה הסיבה שהקוד קפץ ל-ErrorHandler.

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

                          עוד בעיה שמצאתי שזה עובד אצלי תקין רק אם התצוגה מוקטנת, אם אני עומד על תצוגה של 100% זה יוצר שיבושים ורווחים לא תקינים.
                          בנוסף נראה שהקוד לא מתחשב במרווח בין שורות, דהיינו שאם בטור אחד יש מרווח של 16 בפסקה האחרונה ובטור שלידו 18, היישור לא יהיה זהה, אני צודק בטענה? (לא עברתי על הקוד כדי לבדוק).

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

                            עוד בעיה שמצאתי שזה עובד אצלי תקין רק אם התצוגה מוקטנת, אם אני עומד על תצוגה של 100% זה יוצר שיבושים ורווחים לא תקינים.
                            בנוסף נראה שהקוד לא מתחשב במרווח בין שורות, דהיינו שאם בטור אחד יש מרווח של 16 בפסקה האחרונה ובטור שלידו 18, היישור לא יהיה זהה, אני צודק בטענה? (לא עברתי על הקוד כדי לבדוק).

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

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

                            הקוד אכן לא מתחשב ברווח בין שורות תודה על ההערה. יש לך רעיון איך ליישם את זה?

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

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

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

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

                              @pcinfogmach כתב בעזרה | מישהו יכול לבדוק לי את המאקרו יישור טורים דלהלן:

                              האם לדעתך בשביל בעיה 2 מספיק להריץ בדיקה בסוף כל יישור עמוד ואם זה לא ישר אז ליישר שוב?

                              מסתמא שזה יהיה מספיק בהחלט.

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

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

                                @pcinfogmach כתב בעזרה | מישהו יכול לבדוק לי את המאקרו יישור טורים דלהלן:

                                האם לדעתך בשביל בעיה 2 מספיק להריץ בדיקה בסוף כל יישור עמוד ואם זה לא ישר אז ליישר שוב?

                                מסתמא שזה יהיה מספיק בהחלט.

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

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

                                @יאיר-הבהיר כתב בעזרה | מישהו יכול לבדוק לי את המאקרו יישור טורים דלהלן:

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

                                אם המרחק ממש קטן פעולת ההגדלה גם היא לא תשפיע במאומה, הלא כן?

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

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

                                  @יאיר-הבהיר כתב בעזרה | מישהו יכול לבדוק לי את המאקרו יישור טורים דלהלן:

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

                                  אם המרחק ממש קטן פעולת ההגדלה גם היא לא תשפיע במאומה, הלא כן?

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

                                  @pcinfogmach כתב בעזרה | מישהו יכול לבדוק לי את המאקרו יישור טורים דלהלן:

                                  @יאיר-הבהיר כתב בעזרה | מישהו יכול לבדוק לי את המאקרו יישור טורים דלהלן:

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

                                  אם המרחק ממש קטן פעולת ההגדלה גם היא לא תשפיע במאומה, הלא כן?

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

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

                                  • התחברות

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

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