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

u88

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

מניין

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

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

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

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

pcinfogmach

@מניין

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

Sub הקטנת_מרווח_בין_טורים_רק_בהערות_שוליים()
'
' הקטנת_מרווח_בין_טורים_רק_בהערות_שוליים Macro
'
'
 
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
    
    Selection.GoTo What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=currpagenum
    Application.ScreenUpdating = True
End Sub
Sub הרחבת_מרווח_בין_טורים_רק_בהערות_שוליים()
'
' הרחבת_מרווח_בין_טורים_רק_בהערות_שוליים Macro
'
'
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
        
    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
      
    Selection.GoTo What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=currpagenum
    Application.ScreenUpdating = True
    
End Sub

מניין

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

@מניין

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

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

pcinfogmach

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

וגם איך הצלחת באיפוס לאפס את הכל כולל השוליים

With ActiveDocument.PageSetup
.LeftMargin = .RightMargin
End With

כלומר שהשוליים הימניים והשמאליים יהיו אותו דבר (מאחר שרק נגענו בצד אחד ממילא הכל שב למקומו)

u88

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

pcinfogmach

פוסט זה נמחק!

pcinfogmach

@u88
כמדומני שהבעיה היא באיך שוורד יוצר את החלוקה לשלוש

תנסה להעתיק את החלוקה לשלוש מהמסמך המצו"ב במקום
כותרת עליונה חלוקה לשלוש ללא באגים.docx

נא לעדכן אם זה עזר

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

121244

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

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

u88

אם אפשר לקבל את זה בקובץ רגיל

pcinfogmach

@u88

מרווח בהערות שוליים משופר.dotm

אשמח לדעת אם באמת הבעיה נפתרה