מילה ראשונה וחלון בהערות שוליים

pcinfogmach

@121244 כתב במילה ראשונה וחלון בהערות שוליים:

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

הקוד אינו הבעיה
הבעיה היא מה השיטה לעשות את הקוד - כלומר

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

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

הדברים שלבנתיים עזרו לי הם:

לכבות את בקרת שורות מיותמות
לעשות הערות ברצף

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

u88

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

pcinfogmach

@u88
כנראה בגלל הטאבים המיותרים

תנסה במסמך נקי
מסמך נקי.docx

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

pcinfogmach

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

u88

@pcinfogmach תודה רבה בסוף עשיתי עם טבלה ללא גבולות וכל מלל חילקתי שם בצורה שווה
אם יש רעיון אחר אשמח

u88

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

pcinfogmach

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

u88

@pcinfogmach תודה רבה
מצו"ב קובץמוזח לצד .docx

pcinfogmach

@u88

תודה

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

    Sub הקטנת_מרווח_בין_טורים_רק_בהערות_שוליים()
'
' הקטנת_מרווח_בין_טורים_רק_בהערות_שוליים Macro
'
'
Call תיקון_טאבים

If ActiveDocument.Footnotes.Count = 0 Then
MsgBox "אין הערות שוליים במסמך"
Exit Sub
End If
       
Application.ScreenUpdating = False
Dim currpagenum As Integer
currpagenum = Selection.Information(wdActiveEndPageNumber)
 
        ActiveWindow.View.SeekView = wdSeekFootnotes
   
        Selection.WholeStory
        
    With Selection.ParagraphFormat
        .RightIndent = .RightIndent - CentimetersToPoints(0.1)
    End With
    
        Selection.HomeKey Unit:=wdStory
        Selection.WholeStory
        
    With Selection.ParagraphFormat
        .RightIndent = .RightIndent - CentimetersToPoints(0.1)
    End With
    
        With ActiveDocument.PageSetup
        .LeftMargin = .LeftMargin - CentimetersToPoints(-0.1)
    End With
    
    
    ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
  Selection.ParagraphFormat.RightIndent = Selection.ParagraphFormat.RightIndent - CentimetersToPoints(0.1)
    ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
    
    
    Selection.GoTo What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=currpagenum
    Application.ScreenUpdating = True
End Sub
Sub הרחבת_מרווח_בין_טורים_רק_בהערות_שוליים()
'
' הרחבת_מרווח_בין_טורים_רק_בהערות_שוליים Macro
'
'
Call תיקון_טאבים

If ActiveDocument.Footnotes.Count = 0 Then
MsgBox "אין הערות שוליים במסמך"
Exit Sub
End If
        
Application.ScreenUpdating = False
Dim currpagenum As Integer
currpagenum = Selection.Information(wdActiveEndPageNumber)
 
    ActiveWindow.View.SeekView = wdSeekFootnotes
    
    Selection.WholeStory
    
    With Selection.ParagraphFormat
        .RightIndent = .RightIndent - CentimetersToPoints(-0.1)
            End With
            
    Selection.HomeKey Unit:=wdStory
    
    Selection.WholeStory
    
    With Selection.ParagraphFormat
        .RightIndent = .RightIndent - CentimetersToPoints(-0.1)
    End With
    
    With ActiveDocument.PageSetup
        .LeftMargin = .LeftMargin - CentimetersToPoints(0.1)
    End With
    
    ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
  Selection.ParagraphFormat.RightIndent = Selection.ParagraphFormat.RightIndent + CentimetersToPoints(0.1)
    ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
        
    Selection.GoTo What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=currpagenum
    Application.ScreenUpdating = True
    
End Sub
Sub איפוס_כניסות()
'
' מרווח_איפוס Macro
'
'
Application.ScreenUpdating = False
Dim currpagenum As Integer
currpagenum = Selection.Information(wdActiveEndPageNumber)
 
If ActiveDocument.Footnotes.Count = 0 Then
MsgBox "אין הערות שוליים במסמך"
Exit Sub
End If
 
        ActiveWindow.View.SeekView = wdSeekFootnotes
 
        Selection.WholeStory
        
    With Selection.ParagraphFormat
        .RightIndent = CentimetersToPoints(0)
    End With
    
        Selection.HomeKey Unit:=wdStory
        Selection.WholeStory
        
    With Selection.ParagraphFormat
        .RightIndent = CentimetersToPoints(0)
        Selection.MoveLeft Unit:=wdCharacter, Count:=1
    End With
    
    With ActiveDocument.PageSetup
        .LeftMargin = .RightMargin
    End With
      
     ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
  Selection.ParagraphFormat.RightIndent = 0
    ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
    
    Selection.GoTo What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=currpagenum
    Application.ScreenUpdating = True
    
End Sub

Sub תיקון_טאבים()
'
'
'
    Selection.find.ClearFormatting
    Selection.find.Replacement.ClearFormatting
    With Selection.find
        .text = "^48"
        .Replacement.text = "^t"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.find.Execute Replace:=wdReplaceAll
End Sub