עזרה | מישהו יכול לבדוק לי את המאקרו יישור טורים דלהלן
-
@א-מ
תודה
קצת מוזר בעיקרון הכנסתי משהו שמטפל בשגיאות אז לא הייית אמור לראות שום שגיאה גם אם היה אחת
מחכה לנטפרי עם התמונה, לבינתיים אנא וודא שהתשתמשת בקוד האחרון שהעליתי
כמו"כ וודא שהרצת את הפקודה הנכונה יש להריץ את הפקודה AlignColumnsInSelectionעריכה:
אוקיי כעת התמונה נפתחה כנראה שיש לך כבר מאקרו בשם זה פשוט תשנה את שם המאקרו למשהו אחר ותריץ אותו -
@א-מ
תודה
קצת מוזר בעיקרון הכנסתי משהו שמטפל בשגיאות אז לא הייית אמור לראות שום שגיאה גם אם היה אחת
מחכה לנטפרי עם התמונה, לבינתיים אנא וודא שהתשתמשת בקוד האחרון שהעליתי
כמו"כ וודא שהרצת את הפקודה הנכונה יש להריץ את הפקודה AlignColumnsInSelectionעריכה:
אוקיי כעת התמונה נפתחה כנראה שיש לך כבר מאקרו בשם זה פשוט תשנה את שם המאקרו למשהו אחר ותריץ אותו@pcinfogmach ניסיתי שוב ונראה לי שהוא לא מיישר כלום...
הכתב והמכתב - עותק.docx -
@pcinfogmach ניסיתי שוב ונראה לי שהוא לא מיישר כלום...
הכתב והמכתב - עותק.docx@יאיר-הבהיר
אוקיי אני רואה מה הבעיה אתה עשית קיפול לספר נכון? -
@יאיר-הבהיר
אוקיי אני רואה מה הבעיה אתה עשית קיפול לספר נכון?@pcinfogmach צודק.
קשור? -
@pcinfogmach צודק.
קשור?@יאיר-הבהיר
מאוד!
קיפול לספר מגדיר את העמודים באופן כזה ששני עמודים נכנסים בעמוד אחד זה משבש את היכולת של המאקרו לזהות טורים בתוך כל עמוד
רק תאשר לי שאני צודק וכבר אכניס קוד שמטפל בזה בלי נדר -
@יאיר-הבהיר
מאוד!
קיפול לספר מגדיר את העמודים באופן כזה ששני עמודים נכנסים בעמוד אחד זה משבש את היכולת של המאקרו לזהות טורים בתוך כל עמוד
רק תאשר לי שאני צודק וכבר אכניס קוד שמטפל בזה בלי נדר@pcinfogmach ניסיתי גם בלי קיפול ספר ועדיין לא עובד לי...
הכתב והמכתב - עותק.docx -
@יאיר-הבהיר
מאוד!
קיפול לספר מגדיר את העמודים באופן כזה ששני עמודים נכנסים בעמוד אחד זה משבש את היכולת של המאקרו לזהות טורים בתוך כל עמוד
רק תאשר לי שאני צודק וכבר אכניס קוד שמטפל בזה בלי נדר@pcinfogmach אגב, כדאי שתהיה גם פקודה לסוף הקטע, שאם יש קטע שנגמר כך:
אז שיישר אותו כך:
[צריך שיוגדר לו מעבר מקטע מיד בסוף הטקסט, ואז הוא מתיישר כמעט בכל המקרים]
-
@pcinfogmach אגב, כדאי שתהיה גם פקודה לסוף הקטע, שאם יש קטע שנגמר כך:
אז שיישר אותו כך:
[צריך שיוגדר לו מעבר מקטע מיד בסוף הטקסט, ואז הוא מתיישר כמעט בכל המקרים]
@יאיר-הבהיר כתב בעזרה | מישהו יכול לבדוק לי את המאקרו יישור טורים דלהלן:
[צריך שיוגדר לו מעבר מקטע מיד בסוף הטקסט, ואז הוא מתיישר כמעט בכל המקרים]
לא כל כך הבנתי את בקשתך האחרונה סרטון קצר מאוד יעזור
-
@pcinfogmach ניסיתי גם בלי קיפול ספר ועדיין לא עובד לי...
הכתב והמכתב - עותק.docx@יאיר-הבהיר כתב בעזרה | מישהו יכול לבדוק לי את המאקרו יישור טורים דלהלן:
@pcinfogmach ניסיתי גם בלי קיפול ספר ועדיין לא עובד לי...
כמדומני שכוונתך שניסית לבטל את הקיפול
אם אני צודק אזי הבעיה עדיין בעינה עומדת כי ביטול הקיפול איננו מבטל את ההגדרות שמשבשות את המאקרו -
@יאיר-הבהיר כתב בעזרה | מישהו יכול לבדוק לי את המאקרו יישור טורים דלהלן:
@pcinfogmach ניסיתי גם בלי קיפול ספר ועדיין לא עובד לי...
כמדומני שכוונתך שניסית לבטל את הקיפול
אם אני צודק אזי הבעיה עדיין בעינה עומדת כי ביטול הקיפול איננו מבטל את ההגדרות שמשבשות את המאקרו@pcinfogmach כתב בעזרה | מישהו יכול לבדוק לי את המאקרו יישור טורים דלהלן:
@יאיר-הבהיר כתב בעזרה | מישהו יכול לבדוק לי את המאקרו יישור טורים דלהלן:
@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@pcinfogmach סתם שאלה בקשר לתוסף אולי כדאי לייצר הדגשת מילה ראשונה דרך האפשרות בסינית לשתי שורות באותה שורה, ניסית פעם?
-
@pcinfogmach סתם שאלה בקשר לתוסף אולי כדאי לייצר הדגשת מילה ראשונה דרך האפשרות בסינית לשתי שורות באותה שורה, ניסית פעם?
-
@shishko
לא ניסיתי. אתה ניסית והצליח?@pcinfogmach לא, בדיוק לפני כמה דקות חשבתי על זה באופן ידני ודאי ניתן לעשות את זה על אף א"א לעשות יישור לסוף השורה ולכן ישנם אי אלו הבדלים חסרון נוסף שניתן לעשו שני שורות רק עם רווח ביניהם של נקודה 1 ולא 1.5 כמו הגדרת ברירת המחדל השאלה אם אין דרך להתגבר על זה?
וגם אם לא אולי ניתן לעשות את זה כאפשרות נוספת כשהמעלה שהמילה הראשונה היא חלק מהטקסט ויותר קל לבטל את זה במיקום מסויים!!
צריך לבדוק אם אפשר בעיקרון להשתמש בזה גם כשאין סינית על המחשב וכל הבעיה שטכנית זה לא מופיע (דרך אגב אם כן אפשר להוסיף את האפשרויות שיש בסינית לתוסף).
אם יהיה לי זמן אני ינסה לעבוד על זה. -
@pcinfogmach לא, בדיוק לפני כמה דקות חשבתי על זה באופן ידני ודאי ניתן לעשות את זה על אף א"א לעשות יישור לסוף השורה ולכן ישנם אי אלו הבדלים חסרון נוסף שניתן לעשו שני שורות רק עם רווח ביניהם של נקודה 1 ולא 1.5 כמו הגדרת ברירת המחדל השאלה אם אין דרך להתגבר על זה?
וגם אם לא אולי ניתן לעשות את זה כאפשרות נוספת כשהמעלה שהמילה הראשונה היא חלק מהטקסט ויותר קל לבטל את זה במיקום מסויים!!
צריך לבדוק אם אפשר בעיקרון להשתמש בזה גם כשאין סינית על המחשב וכל הבעיה שטכנית זה לא מופיע (דרך אגב אם כן אפשר להוסיף את האפשרויות שיש בסינית לתוסף).
אם יהיה לי זמן אני ינסה לעבוד על זה. -
@יאיר-הבהיר כתב בעזרה | מישהו יכול לבדוק לי את המאקרו יישור טורים דלהלן:
[צריך שיוגדר לו מעבר מקטע מיד בסוף הטקסט, ואז הוא מתיישר כמעט בכל המקרים]
לא כל כך הבנתי את בקשתך האחרונה סרטון קצר מאוד יעזור
@pcinfogmach כתב בעזרה | מישהו יכול לבדוק לי את המאקרו יישור טורים דלהלן:
@יאיר-הבהיר כתב בעזרה | מישהו יכול לבדוק לי את המאקרו יישור טורים דלהלן:
[צריך שיוגדר לו מעבר מקטע מיד בסוף הטקסט, ואז הוא מתיישר כמעט בכל המקרים]
לא כל כך הבנתי את בקשתך האחרונה סרטון קצר מאוד יעזור
ffc2cf7d-3590-4dc3-8af9-c20a05afa16f-bandicam 2024-10-27 01-45-12-677.mp4
-
@pcinfogmach כתב בעזרה | מישהו יכול לבדוק לי את המאקרו יישור טורים דלהלן:
@יאיר-הבהיר כתב בעזרה | מישהו יכול לבדוק לי את המאקרו יישור טורים דלהלן:
@pcinfogmach ניסיתי גם בלי קיפול ספר ועדיין לא עובד לי...
כמדומני שכוונתך שניסית לבטל את הקיפול
אם אני צודק אזי הבעיה עדיין בעינה עומדת כי ביטול הקיפול איננו מבטל את ההגדרות שמשבשות את המאקרונכון, אבל גם על מסמך חדש זה עובד לי רק על חלק מהעמודים, ויש עמודים שהוא לא מסתדר איתם כל כך...
@יאיר-הבהיר
מצאתי שגיאה בקוד שלי אנא נסה כעת בקוד המעודכןעריכה:
ערכתי עוד כמה דברים בקוד כעת הוא אמור לעבוד גם בקבצים עם קיפול
בדקתי ועבד אצלי על הקובץ שהעלית -
@pcinfogmach כתב בעזרה | מישהו יכול לבדוק לי את המאקרו יישור טורים דלהלן:
@יאיר-הבהיר כתב בעזרה | מישהו יכול לבדוק לי את המאקרו יישור טורים דלהלן:
[צריך שיוגדר לו מעבר מקטע מיד בסוף הטקסט, ואז הוא מתיישר כמעט בכל המקרים]
לא כל כך הבנתי את בקשתך האחרונה סרטון קצר מאוד יעזור
ffc2cf7d-3590-4dc3-8af9-c20a05afa16f-bandicam 2024-10-27 01-45-12-677.mp4
@יאיר-הבהיר
קבצים מסוג זה נחסמים בנטפרי אשמח אם תשלח לי במייל בתוך קובץ זיפ -
@יאיר-הבהיר
מצאתי שגיאה בקוד שלי אנא נסה כעת בקוד המעודכןעריכה:
ערכתי עוד כמה דברים בקוד כעת הוא אמור לעבוד גם בקבצים עם קיפול
בדקתי ועבד אצלי על הקובץ שהעלית@pcinfogmach כתב בעזרה | מישהו יכול לבדוק לי את המאקרו יישור טורים דלהלן:
@יאיר-הבהיר
מצאתי שגיאה בקוד שלי אנא נסה כעת בקוד המעודכןעריכה:
ערכתי עוד כמה דברים בקוד כעת הוא אמור לעבוד גם בקבצים עם קיפול
בדקתי ועבד אצלי על הקובץ שהעליתעכשיו זה באמת עבד לי מצוין, רק שתי הארות:
- לפעמים נוצרים רווחים גדולים מדי שלא נצרכים בשביל היישור הפשוט.
- אם אחרי שהוא יישר את הטור הימני פתאום עברה שורה מהטור השמאלי לעמוד הבא [מאיזו סיבה שלא תהיה] - נראה לי שהוא לא קולט את זה...
בהצלחה!
-
@pcinfogmach כתב בעזרה | מישהו יכול לבדוק לי את המאקרו יישור טורים דלהלן:
@יאיר-הבהיר
מצאתי שגיאה בקוד שלי אנא נסה כעת בקוד המעודכןעריכה:
ערכתי עוד כמה דברים בקוד כעת הוא אמור לעבוד גם בקבצים עם קיפול
בדקתי ועבד אצלי על הקובץ שהעליתעכשיו זה באמת עבד לי מצוין, רק שתי הארות:
- לפעמים נוצרים רווחים גדולים מדי שלא נצרכים בשביל היישור הפשוט.
- אם אחרי שהוא יישר את הטור הימני פתאום עברה שורה מהטור השמאלי לעמוד הבא [מאיזו סיבה שלא תהיה] - נראה לי שהוא לא קולט את זה...
בהצלחה!
@יאיר-הבהיר
יישר כח על כל העזרה
לגבי ההארות שלך מאוד יעזור לי אם תוכל לייצר לי קובץ בו הבעיות שהעלית קורים
אשמח מאוד גם לקבל ניתוח של מה גורם לבעיות הללו כלומר בלו מצבים היישור גורם לרווחים גדולים ובאלו מצבים פתאום עובר שורה לעמוד הבא
האם לדעתך בשביל בעיה 2 מספיק להריץ בדיקה בסוף כל יישור עמוד ואם זה לא ישר אז ליישר שוב? -
מצו"ב מאקרו חדש ליישור טורים בוורד עבור התוסף לוורד עיצוב תורני אשמח אם מישהו יוכל לבדוק לי את הביצועים שלו
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@pcinfogmach דבר ראשון כל הכבוד על ההשקעה!!!
שנית, קיבלתי את השגיאה הזאת:
כנראה שלא הגדרת משתנים גלובליים.
עדיין לא בדקתי מה הסיבה שהקוד קפץ ל-ErrorHandler.
![חיפוש גוגל בפורום](javascript:{bootbox.prompt({title:'<div style="text-align: center;"><img src="/assets/uploads/files/1625950269825-mt-google.png" width="400"></div>',placeholder:'כתוב מילים לחיפוש ב Google',buttons:{confirm:{label:'חיפוש'},cancel:{label:'ביטול'}},backdrop:true,callback:function(result){if(result!=null&&result!=''){var a=document.createElement('a');a.href='https://www.google.co.il/search?q=site:mitmachim.top '+encodeURIComponent(result.trim());a.target='_blank';a.click();}}})();};){kind=link}