@menajemmendel
שדרגתי את המאקרו של מעבר עמוד, למאקרו שפועל אוטמטי על כל הכותרות הנדרשות.
המאקרו מחפש מהו הסגנון שעליו עומד הסמן ברגע הפעלת המאקרו, ומוסיף לפני כל מופע של סגנון זה במסמך, מעבר עמוד.
ניתן לבטל את כל הוספת מעברי עמוד שהמאקרו עשה בלחיצה פעם אחת על ביטול פעולה אחרונה.
Sub הוספת_מעבר_עמוד_לפי_סגנון_כל_המסמך()
'
' הוספת_מעבר_עמוד_לפי_סגנון_כל_המסמך Macro
'
'
Application.ScreenUpdating = False
Selection.Find.ClearFormatting
SIGNON = Selection.Style
Dim my_undo As Object
Set my_undo = Application.UndoRecord
my_undo.StartCustomRecord ("הוספת מעבר עמוד לפי סגנון")
On Error GoTo ending
Dim rng, oRange As Range
Set rng = Selection.Range
Selection.WholeStory
Set oRange = Selection.Range
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "^p"
.Replacement.Text = "#^p"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchKashida = False
.MatchDiacritics = False
.MatchAlefHamza = False
.MatchControl = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
start:
With Selection.Find
.ClearFormatting
.Text = "#"
.Style = SIGNON
.Forward = True
.Wrap = wdFindContinue
Selection.Find.Execute
If Not Selection.Range.InRange(oRange) Then GoTo ext
If .Found = True Then
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.HomeKey Unit:=wdLine
Selection.InsertBreak Type:=0
GoTo start
End If
End With
ext:
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "#"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchKashida = False
.MatchDiacritics = False
.MatchAlefHamza = False
.MatchControl = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchKashida = False
.MatchDiacritics = False
.MatchAlefHamza = False
.MatchControl = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
rng.Select
ending:
my_undo.EndCustomRecord
Application.ScreenUpdating = True
End Sub
