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

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