בירור | קוד מאקרו ליישור שני טורים בוורד

[משתמש מקצוען]

@שמעלקא-0 איך אפשר ליצור איתך קשר?

[שמעלקא 0]

פוסט זה נמחק!

[poker]

המקרו של רחמים רץ על כל המסמך באופן אוטומטי ומסדר את הכל.

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

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

[מניין]

@poker אמר בבירור | קוד מאקרו ליישור שני טורים בוורד:

המקרו של רחמים רץ על כל המסמך באופן אוטומטי ומסדר את הכל.

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

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

[שמעלקא 0]

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

הנה הקובץ:
[מעדכן את הפוסט: בהמשך השרשור יש גירסה מעודכנת יותר של הקובץ]
LineToLines1.dot

תודה ל @NykUser שכתב את הפוסט הזה, שהועיל לי בענין ההתקנה.

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

[NykUser]

@שמעלקא-0

תודה ל @NykUser שכתב את הפוסט הזה, שהועיל לי בענין ההתקנה.

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

לחברים המומחים ב-VBA:
הקובץ הוא גירסה ראשונית, שעובדת יפה.
אך יש כמה דברים שעשויים לתקוע את הקוד, ואבקש את עזרת המומחים בשיפורו:

אשמח לעזור למי שעוזר לאחרים!

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

שומרים זאת בתוך הregistry זהו דוגמה

Spoiler

System.PrivateProfileString("", "HKEY_CURRENT_USER\Software\WordVBA_LineToLine", "Max") = "5"
MsgBox (System.PrivateProfileString("", "HKEY_CURRENT_USER\Software\WordVBA_LineToLine", "Max"))

ב. האם יש פונקציה שבודקת האם אני בטור הראשון או השני.

בעבר חיפשתי פונקציית vba מובנית ולא מצאתי, מישהו יודע?
זוהי פונקציה שכתבתי שמחזירה את ההפרש בין טור 1 ל-2, זה כנראה יענה על הצורך שלך.

Spoiler

Public Sub tryout()
    MsgBox (ColumnsDifference)
End Sub
Public Function ColumnsDifference() As Double
If Selection.PageSetup.TextColumns.Count <> 2 Then MsgBox ("More then 2 Columns"): Exit Function
Application.ScreenUpdating = False
Dim WRange As Range
Dim NumLines, WPage, i, col1, col2, Difference, Ignore As Double
NumLines = ActiveDocument.Bookmarks("\page").Range.ComputeStatistics(wdStatisticLines)
ActiveDocument.Bookmarks("\page").Range.Select
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Set WRange = ActiveDocument.Bookmarks("\page").Range
WRange.SetRange START:=WRange.End - 2, End:=WRange.End
col2 = WRange.Information(wdVerticalPositionRelativeToPage)
For i = 1 To NumLines
    Selection.MoveDown wdLine, 1
    If col1 > Selection.Information(wdVerticalPositionRelativeToPage) Then
        Exit For
    Else
        col1 = Selection.Information(wdVerticalPositionRelativeToPage)
    End If
Next
ActiveDocument.Bookmarks("\page").Range.Select
Selection.MoveLeft Unit:=wdCharacter, Count:=1
If col1 > col2 Then Difference = col1 - col2
If col1 < col2 Then Difference = col2 - col1
ColumnsDifference = Difference
Application.ScreenUpdating = True
End Function

ג. האם יש פונקציה פשוטה שמחזירה את מספר הפיסקה שלי.

הראשון למספר מתחילת הקובץ, השני לדף זה (המספר מתחיל באפס כרגיל בקוד)

Spoiler

Set MyRange = Selection.Range
MyRange.SetRange START:=ActiveDocument.Paragraphs(1).Range.START, End:=MyRange.End
MsgBox (MyRange.ComputeStatistics(wdStatisticParagraphs))

Set MyRange = Selection.Range
MyRange.SetRange START:=ActiveDocument.Bookmarks("\page").Range.START, End:=MyRange.End
MsgBox (MyRange.ComputeStatistics(wdStatisticParagraphs))

ד. האם יש פונקציה שמובילה אותי לשורה האחרונה בעמוד.

זה

Spoiler

Set MyRange = ActiveDocument.Bookmarks("\page").Range
MyRange.SetRange START:=MyRange.End - 1, End:=MyRange.End
MyRange.Select

[נתן מרדכי שלום]

@שמעלקא-0 לא הולך לי, אולי תעלה את הפקודה עצמה שכל אחד יוכל להעתיק ישירות לפקודת מאקרו?

סתם כך, אתה תעשה טובה להרבה יהודים אם תפרסם זאת גם בפורום 'פרוג'.

[es0583292679]

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

@NykUser כתב בבירור | קוד מאקרו ליישור שני טורים בוורד:

שומרים זאת בתוך הregistry זהו דוגמה
Spoiler

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

[NykUser]

@es0583292679 כתב בבירור | קוד מאקרו ליישור שני טורים בוורד:

לא מבין למה זה צריך להגיע עד לרגיסטרי...

כמובן שזה תלוי לאיזה צורך הוא רוצה את זה

1. אפשר לשומר המידע בתוך משתנה גלובלי

Spoiler

Module-level variables can be declared with a Dim or Private statement at the top of the module above the first procedure definition
Any of these will reset global variables: Using End, An unhandled runtime error, Editing code, Closing the word or file containing the VB project

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

Spoiler

ActiveDocument.Variables("LineToLineMax") = "5"

כדי לקבל את המידע, תחילה עליך לבדוק אם המשתנה נמצא

For Each avar In ActiveDocument.Variables
    If avar.Name = "LineToLineMax" Then MsgBox (ActiveDocument.Variables("LineToLineMax"))
Next avar

3. ברגיסטרי כמו שכתבתי לעיל, או בכל מקום אחר כמו קובץ ini או xml וזה יהיה זמין גם בקבצים חדשים

[מאקרו]

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

ג. האם יש פונקציה פשוטה שמחזירה את מספר הפיסקה שלי.

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

Function ParagraphNum(aRange As Range)
    Dim MyRange As Range
    Set MyRange = ActiveDocument.Range(ActiveDocument.Range.Start, aRange.Start)
    ParagraphNum = MyRange.Paragraphs.Count
End Function

דוגמא לשימוש בקוד:

MsgBox ParagraphNum(Selection.Range)

[נוכחות]

פוסט זה נמחק!

[es0583292679]

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

[שמעלקא 0]

נראה לי שכדאי שההגדרות האישיות ל-MIN ו-MAX תשמרנה באותו קובץ בלבד לפעמים הבאות. כך שלא ישתבש העימוד של אותו הספר או העלון.
אך אולי טוב שתהיה אפשרות לשמור הגדרות לכל המסמכים.
בכל אופן איני יודע איך לעשות זאת. אנסה לשחק עם הקודים דלעיל.

תודה רבה לשולחי הקודים, על הפוסטים המתעדכנים!

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

[es0583292679]

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

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

---

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

אגב, טוב לדעת שהתוסף של יעקובוב ליישור הטורים עולה 280, ולהערות רציפות 600, ראה כאן.

[דאנציג]

@es0583292679 ראה כאן.

[NykUser]

@שמעלקא-0 כתב

תיבת הטקסט הנזכרת מוגדרת כשורה 1, והמילה שאחריה כשורה 2. וכשאני עובר לשורה 2 המחשב מזהה שעברו שורה אך לא ירדו למטה בדף. והוא חושב שעברתי לשורה המקבילה בעמודה השניה.

בקוד שהעליתי כאן לא יהא לך בעיה זה

@es0583292679 כתב

אלא שלו יש שיטה אחרת במילת הפתיח (איני יודע אם מותר לספר כיצד עובדת השיטה שלו).

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

Spoiler

Set MyRange = Selection.Range
For i = 1 To MyRange.Paragraphs.Count
    Set para = MyRange.Paragraphs(i).Range
    If MyRange.Paragraphs(i).Alignment = wdAlignParagraphJustify = False Then GoTo nxt
    Select Case para.ComputeStatistics(wdStatisticLines)
    Case 1: GoTo nxt: 'Case 2: GoTo nxt
    Case Else
        With para: .Collapse: .MoveUntil cset:=" ": .MoveEnd: .Collapse Direction:=wdCollapseEnd
            If .Previous(Count:=2) = Chr(93) Or .Previous(Count:=2) = Chr(41) Then
            .MoveUntil cset:=" ": .MoveEnd: .Collapse Direction:=wdCollapseEnd
            End If
        .Select
        End With
        
        
        With Selection: .EndKey Unit:=wdLine
        If .Text = Chr(11) Then GoTo nxt:
        .TypeText Text:=Chr(11) & ChrW(8197)
        Set Char = Selection.Range
        .Previous.Font.Spacing = Char.Information(wdHorizontalPositionRelativeToTextBoundary) - para.Information(wdHorizontalPositionRelativeToTextBoundary)
        End With
    
    End Select
    nxt:
Next

[es0583292679]

@דאנציג
לא זה לא.

@NykUser
הרעיון אצלי שניתן לעצבה את כל מילות הפתיח יחד, ולא רק גופן וגודל וכו', אלא גם גובה ועובי וכו'.

---

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

[שמעלקא 0]

@NykUser
הקודים שלך מדהימים, מקסימים ונקיים. תודה רבה! אנסה לשפר בהם את הקוד של היישור טורים.

@es0583292679
כל הכבוד על ההתלהבות שלך למען עם ישראל וכו'.

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

אנסה לשמור הגדרות אישיות במקור חיצוני. מקווה שאצליח...

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

[NykUser]

@es0583292679

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

כן , כך זה בכל עימוד בוורד
יש לך מהלך שאינו משתנה עם הוספה? אדרבה!

למשל שיהיה מאקרו שיחפש את התוספת וישמיט אותה...

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

Spoiler

Sub delete_Holon()
If Selection.Type = wdSelectionNormal Then
    Set MyRange = Selection.Range
        MyRange.SetRange Selection.Paragraphs.First.Range.START, Selection.Paragraphs.Last.Range.End
    Else
    Set MyRange = ActiveDocument.StoryRanges(Selection.StoryType)
End If
MyRange.find.Execute FindText:=Chr(11) & ChrW(8197), ReplaceWith:="", Forward:=True, Wrap:=wdFindStop, Replace:=wdReplaceAll
End Sub

[es0583292679]

@NykUser כתב בבירור | קוד מאקרו ליישור שני טורים בוורד:

כן , כך זה בכל עימוד בוורד
יש לך מהלך שאינו משתנה עם הוספה? אדרבה!

מה שיש בתוכנה שלנו למשל (כתר תורה).

(ומה שיש ליעקובוב, אע"פ שאינו עומד בזה אך הוא מתתקן בעה"י ע"י הרצה חוזרת, נראה לי לא ניסיתי אך זה כך לפי החשבון).