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

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

    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
    י מנותק
    י מנותק
    יאיר הבהיר
    כתב נערך לאחרונה על ידי
    #2

    @pcinfogmach ניסיתי להריץ את הפקודה [העליונה, כן?] ולא עבד לי טוב, הוא ייצר כמה רווחים לא הגיוניים ולא יישר. אין לי מושג אם עשיתי נכון...

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

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

      @pcinfogmach ניסיתי להריץ את הפקודה [העליונה, כן?] ולא עבד לי טוב, הוא ייצר כמה רווחים לא הגיוניים ולא יישר. אין לי מושג אם עשיתי נכון...

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

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

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

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

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

        מחזיר שגיאה.
        7d5c02a6-dcf0-4caf-8edf-3a7f5f7c8828-image.png

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

          מחזיר שגיאה.
          7d5c02a6-dcf0-4caf-8edf-3a7f5f7c8828-image.png

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

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

          עריכה:
          אוקיי כעת התמונה נפתחה כנראה שיש לך כבר מאקרו בשם זה פשוט תשנה את שם המאקרו למשהו אחר ותריץ אותו

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

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

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

            עריכה:
            אוקיי כעת התמונה נפתחה כנראה שיש לך כבר מאקרו בשם זה פשוט תשנה את שם המאקרו למשהו אחר ותריץ אותו

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

            @pcinfogmach ניסיתי שוב ונראה לי שהוא לא מיישר כלום...
            ‏‏הכתב והמכתב - עותק.docx

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

              @pcinfogmach ניסיתי שוב ונראה לי שהוא לא מיישר כלום...
              ‏‏הכתב והמכתב - עותק.docx

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

              @יאיר-הבהיר
              אוקיי אני רואה מה הבעיה אתה עשית קיפול לספר נכון?

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

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

                @יאיר-הבהיר
                אוקיי אני רואה מה הבעיה אתה עשית קיפול לספר נכון?

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

                @pcinfogmach צודק.
                קשור?

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

                  @pcinfogmach צודק.
                  קשור?

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

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

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

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

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

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

                    @pcinfogmach ניסיתי גם בלי קיפול ספר ועדיין לא עובד לי... 🤔
                    ‏‏הכתב והמכתב - עותק.docx

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

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

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

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

                      ab80359b-83b1-4262-aadf-bc4dc3c850ef-image.png

                      אז שיישר אותו כך:

                      89890187-6d68-4450-ad5a-36c587a61dcf-image.png

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

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

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

                        ab80359b-83b1-4262-aadf-bc4dc3c850ef-image.png

                        אז שיישר אותו כך:

                        89890187-6d68-4450-ad5a-36c587a61dcf-image.png

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

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

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

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

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

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

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

                          @pcinfogmach ניסיתי גם בלי קיפול ספר ועדיין לא עובד לי... 🤔
                          ‏‏הכתב והמכתב - עותק.docx

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

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

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

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

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

                          י תגובה 1 תגובה אחרונה
                          0
                          • 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

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