שיתוף | יישור טורים מאקרו חדש!!!
-
@pcinfogmach כתב בשיתוף | יישור טורים מאקרו חדש!!!:
@ישראל-כהן
תנסה את התוסף שלי
https://mitmachim.top/post/626904התקנתי, ומופיעה לי תיבה שכתוב בה כך:
"לא ניתן למצוא את המאקרו או שהוא אינו זמין בשל הגדרות אבטחת המאקרו".ניסיתי את כל מה שכתבת פה, https://mitmachim.top/topic/63879/להורדה-תוסף-לוורד-תוסף-עיצוב-תורני/2?_=1711318572441
וזה עדיין לא עזר.
מה עוד יכול להיות?@ישראל-כהן
לא יודע סליחה.
אתה יכול הלעתיק משם את המאקרו ולהשתמש בו -
@ישראל-כהן
לא יודע סליחה.
אתה יכול הלעתיק משם את המאקרו ולהשתמש בו@pcinfogmach כתב בשיתוף | יישור טורים מאקרו חדש!!!:
@ישראל-כהן
לא יודע סליחה.
אתה יכול הלעתיק משם את המאקרו ולהשתמש בוהוא לא נותן לי בכלל לצפות במאקרו. הוא כאילו כלל לא קיים. (גם כשאני לוחץ "צעד לתוך", המסך פשוט נסגר).
בכל אופן, תודה על הכל.
(יש מצב לשלוח לי בפרטי את המאקרו הזה?) -
@רפרם-ב-ר-פפא
התקנתי את המאקרו, וכשאני לוחץ על 'הפעל', מופיעה לי תקלה זו
מה עשיתי לא טוב?
תודה רבה רבה!@ישראל-כהן
יש לך תיבת טקסט או מסגרת במסמך? -
@pcinfogmach כתב בשיתוף | יישור טורים מאקרו חדש!!!:
@ישראל-כהן
תנסה את התוסף שלי
https://mitmachim.top/post/626904התקנתי, ומופיעה לי תיבה שכתוב בה כך:
"לא ניתן למצוא את המאקרו או שהוא אינו זמין בשל הגדרות אבטחת המאקרו".ניסיתי את כל מה שכתבת פה, https://mitmachim.top/topic/63879/להורדה-תוסף-לוורד-תוסף-עיצוב-תורני/2?_=1711318572441
וזה עדיין לא עזר.
מה עוד יכול להיות?@ישראל-כהן
עשית את זה?פתח את לוח הבקרה: ניתן לגשת ללוח הבקרה על ידי חיפוש בתיבת החיפוש של Windows "לוח הבקרה". בלוח הבקרה, תמצא את האפשרות המסומנת "שעה ואזור" ולחץ עליה. כעת לחץ על "אזור": בחלון "אזור", ישנם מספר כרטיסיות בחלק העליון. לחץ על כרטיסיית "ניהולי". לחץ על "שינוי אזור מערכת...": בכרטיסיית "מנהלי", יש כפתור המסומן "שינוי אזור מערכת...". לחץ עליו. בחר עברית (ישראל): בחלון הקופץ, גלול ברשימה עד שתמצא "עברית (ישראל)". בחר את האפשרות הזו. לחץ על אישור ואז הפעל את המחשב מחדש: -
@ישראל-כהן
יש לך תיבת טקסט או מסגרת במסמך?@רפרם-ב-ר-פפא כתב בשיתוף | יישור טורים מאקרו חדש!!!:
@ישראל-כהן
יש לך תיבת טקסט או מסגרת במסמך?אכן. יש לי מסגרת מסביב לתיבה הראשונה.
חשבתי שזו יכולה להיות הבעיה. אבל מאידך, אם אני יישר את הטורים, ורק לאחר מכן אעשה את המסגרת הזו, יכול מאד להיות שיישור הטורים ישתבש, (כיון שלפעמים אחרי שהמילה הראשונה תגדל, היא תדחוף את המילה האחרונה בשורה לשורה הבאה וכו', וכך לפעמים תתווסף שורה בסוף הקטע). אין לזה פתרון?
תודה ענקית על הכל! -
@רפרם-ב-ר-פפא כתב בשיתוף | יישור טורים מאקרו חדש!!!:
@ישראל-כהן
יש לך תיבת טקסט או מסגרת במסמך?אכן. יש לי מסגרת מסביב לתיבה הראשונה.
חשבתי שזו יכולה להיות הבעיה. אבל מאידך, אם אני יישר את הטורים, ורק לאחר מכן אעשה את המסגרת הזו, יכול מאד להיות שיישור הטורים ישתבש, (כיון שלפעמים אחרי שהמילה הראשונה תגדל, היא תדחוף את המילה האחרונה בשורה לשורה הבאה וכו', וכך לפעמים תתווסף שורה בסוף הקטע). אין לזה פתרון?
תודה ענקית על הכל!@ישראל-כהן
אל תעשה מסגרת יש שיטות אחרות לעשות מילה ראשונה תלויה -
@ישראל-כהן
אל תעשה מסגרת יש שיטות אחרות לעשות מילה ראשונה תלויה@pcinfogmach כתב בשיתוף | יישור טורים מאקרו חדש!!!:
@ישראל-כהן
אל תעשה מסגרת יש שיטות אחרות לעשות מילה ראשונה תלויהוהן?
-
חדש! מאקרו ליישור טורים
והפעם בקוד פתוח לצורך שיפור המאקרו ע"י כל החברים
להערות הארות נא לדווח
וכן כל דבר שיכול לשפר את הפעולה
מצורף קובץ תבנית וורד אם אפשרות ליישור עמוד 1 או יישור כל המסמך
עדכון אדר תשפ"ג
יישור טורים 3.dotmוכן הקוד שכתבתי
Public Sub יישור_טורים() 'בודק אם יש שני טורים If Selection.PageSetup.TextColumns.Count <> 2 Then MsgBox ("לא נמצאו 2 טורים"): Exit Sub 'עדכון מסך שקר Application.ScreenUpdating = False Dim WRange, Endcol2, Startcol1, Rcol1, Rcol2 As Range Dim NumLines, WPage, Pcol1, Pcol2, APcol, PPS, a, i, B, C, P, S, col1, col2, Acol, Ignore As Double 'שומר תחילת שורה של מיקום נוכחי Selection.HomeKey Unit:=wdLine Set My = Selection.Range 'תחילת עמוד Set WRange = ActiveDocument.Bookmarks("\page").Range WRange.SetRange Start:=WRange.Start, End:=WRange.Start + 1 WRange.Select Set Startpage = Selection.Range WRange.SetRange Start:=Startpage.End, End:=My.End 'סופר שורות WRange.Select SLines = Selection.Range.ComputeStatistics(wdStatisticLines) 'חוזר ומפעיל לולאת בדיקה שאין כותרת' My.Select 'Startcol1 מגדיר תחילת טור 1 For S = 1 To SLines - 1 Selection.GoTo What:=wdGoToLine, Which:=wdGoToPrevious, Count:=1, Name:="" If Selection.PageSetup.TextColumns.Count <> 2 Then Exit For Else Set Startcol1 = Selection.Range End If Next 'סוף עמוד Set WRange = ActiveDocument.Bookmarks("\page").Range WRange.SetRange Start:=WRange.End - 1, End:=WRange.End WRange.Select Set Endpage = Selection.Range WRange.SetRange Start:=My.Start, End:=Endpage.End 'סופר שורות WRange.Select ELines = Selection.Range.ComputeStatistics(wdStatisticLines) My.Select 'Endcol2 מגדיר סוף טור 2 For S = 1 To ELines - 1 Selection.GoTo What:=wdGoToLine, Which:=wdGoToNext, Count:=1, Name:="" If Selection.PageSetup.TextColumns.Count <> 2 Then Exit For Else Set Endcol2 = Selection.Range End If Next 'מספר שורות כולל שני טורים Set WRange = Selection.Range WRange.SetRange Start:=Startcol1.End, End:=Endcol2.End WRange.Select NumLines = Selection.Range.ComputeStatistics(wdStatisticLines) ' - col2 מגדיר גובה טור 2 Endcol2.Select col2 = Endcol2.Information(wdVerticalPositionRelativeToPage) Selection.EndKey Unit:=wdLine Set Endcol2 = Selection.Range ' col1מגדיר גובה טור -1 'Endcol1- סוף טור 1 'Startcol2- תחילת טור2 Startcol1.Select For i = 1 To NumLines Selection.GoTo What:=wdGoToLine, Which:=wdGoToNext, Count:=1, Name:="" If col1 > Selection.Information(wdVerticalPositionRelativeToPage) Then Set Startcol2 = Selection.Range Exit For Else col1 = Selection.Information(wdVerticalPositionRelativeToPage) Set Endcol1 = Selection.Range End If Next 'סוף טור 1 = סוף שורה Endcol1.Select Selection.EndKey Unit:=wdLine Set Endcol1 = Selection.Range 'Acol מגדיר הפרש בין טורים If col1 > col2 Then Acol = col1 - col2 If col1 < col2 Then Acol = col2 - col1 'בודק אם טורים ישרים If Acol < 0.05 Then MsgBox "טורים ישרים" 'אם רווח גדול מידי מוסיף בסוף פסקה בטור 1 ElseIf Acol > 50 Then Endcol2.Select ActiveDocument.Range(Start:=Selection.Start, End:=Selection.Start). _ InsertBreak Type:=wdSectionBreakContinuous Selection.Start = Selection.Start + 1 ActiveDocument.Range(Start:=Selection.End, End:=Selection.End).InsertBreak _ Type:=wdSectionBreakContinuous With Selection.PageSetup.TextColumns .SetCount NumColumns:=1 .EvenlySpaced = True .LineBetween = False End With ElseIf Acol > 0.05 Then 'Pcol1 - מספר פסקאות טור 1 WRange.SetRange Start:=Startcol1.Start, End:=Endcol1.End - 2 WRange.Select Set Rcol1 = Selection.Range Rcol1.Select Pcol1 = (Rcol1.ComputeStatistics(wdStatisticParagraphs)) 'Pcol2 - מספר פסקאות טור 2 WRange.SetRange Start:=Startcol2.Start, End:=Endcol2.End - 2 WRange.Select Set Rcol2 = Selection.Range Rcol2.Select Pcol2 = (Rcol2.ComputeStatistics(wdStatisticParagraphs)) 'טור מרובה פסקאות If Pcol1 > Pcol2 Then 'עורך טור1 ' PPS - מחלק הפרש בין פסקאות PPS = Acol / Pcol1 'עבור לשורה ראשונה בטור Startcol1.Select 'מפעיל פקודת תיקון בלולאה *מס' פסקאות For P = 1 To Pcol1 'אם If col1 > col2 Then 'מקטין רווח אחרי פסקה With Selection For B = 1 To .Paragraphs.Count .Paragraphs(B).Format.SpaceAfter = .Paragraphs(B).Format.SpaceAfter - PPS Next B End With 'עבור לפסקה הבאה Selection.MoveDown wdParagraph, 1 ElseIf col1 < col2 Then 'מוסיף רווח אחרי פסקה With Selection For B = 1 To .Paragraphs.Count .Paragraphs(B).Format.SpaceAfter = .Paragraphs(B).Format.SpaceAfter + PPS Next B End With 'עבור לפסקה הבאה Selection.MoveDown wdParagraph, 1 End If Next Else 'עורך טור 2 'מחלק הפרש בין פסקאות PPS = Acol / Pcol2 'עבור לשורה ראשונה בטור 2 Startcol2.Select 'מפעיל פקודת תיקון בלולאה *מס' פסקאות For P = 1 To Pcol2 If col1 > col2 Then 'מוסיף רווח אחרי פסקה With Selection For B = 1 To .Paragraphs.Count .Paragraphs(B).Format.SpaceAfter = .Paragraphs(B).Format.SpaceAfter + PPS Next B End With 'עבור לפסקה הבאה Selection.MoveDown wdParagraph, 1 ElseIf col1 < col2 Then 'מקטין רווח אחרי פסקה With Selection For B = 1 To .Paragraphs.Count .Paragraphs(B).Format.SpaceAfter = .Paragraphs(B).Format.SpaceAfter - PPS Next B End With 'עבור לפסקה הבאה Selection.MoveDown wdParagraph, 1 End If Next End If End If Application.ScreenUpdating = True End Sub -
@רפרם-ב-ר-פפא יישר כח עצום!
להדיוטות כמוני: איך אני מכניס את פקודת המאקרו שתהיה בוורד תמיד?
לא הצלחתי ליישר טורים לפי האמור רק כשהעתקתי קובץ קיים לתוך קובץ הוורד של המאקרו...
אני מבין שזה לא אמור להיות כך...שבוע טוב והמון שכוייח
@משה-גל
תתקין את התוסף וורד תורני, יש את הפקודה הזאת ועוד הרבה
https://mitmachim.top/topic/63879/להורדה-תוסף-לוורד-תוסף-עיצוב-תורני
![חיפוש גוגל בפורום](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}