Marie,
Are you speaking of deleting a section break, and then the header/footer in
the area ABOVE that section break you just deleted changes into the
header/footer of the section BELOW the deleted section break?
If so, the following subroutines will delete the section break of the
CURRENT section (i.e., BELOW the cursor) and change the header/footer of the
what had been the NEXT section into the current section's header/footer.
The result is the merging the CURRENT and NEXT sections into one larger
section that retains the formerly NEXT section's header/footer.
ReplaceSectionBreakNext is the macro that you execute. Recommend that you
assign to a menu button with title something like "Merge NEXT Section into
CURRENT".
*** BEGIN CODE ***
Sub ReplaceSectionBreakNext()
'
' ReplaceSectionBreakNext Macro
'
' (c) John A. Young, Jr.
'
' Replaces the NEXT Section's (i.e., the Section BELOW the Current Section)
' Section Break with a copy of the Current Section's Section Break, and
' deletes the Current Section's Section Break, merging the NEXT Section
' with the CURRENT Section
' NOTE: The new, expanded CURRENT Section retains the original CURRENT
' Section Page Format!
' Shortcut Key : None
' Menu Text = Merge NEXT Section into CURRENT
' Menu Image = MergePrevButton.bmp
'
' Declare & Define Variables
'
' ** START **
'
' Store CURRENT Section Page Format parameters
With Selection.PageSetup
PSize = .PaperSize
LineNum = .LineNumbering.Active
POrient = .Orientation
TMar = .TopMargin
BMar = .BottomMargin
LMar = .LeftMargin
RMar = .RightMargin
GMar = .Gutter
HDist = .HeaderDistance
FDist = .FooterDistance
PWidth = .PageWidth
PHeight = .PageHeight
FirstTray = .FirstPageTray
OtherTray = .OtherPagesTray
SectType = .SectionStart
OddEven = .OddAndEvenPagesHeaderFooter
DiffFirst = .DifferentFirstPageHeaderFooter
VAlign = .VerticalAlignment
SupNotes = .SuppressEndnotes
MMar = .MirrorMargins
TwoPage = .TwoPagesOnOne
GPos = .GutterPos
End With
'
' Get Total Number of Sections in Document
LastSect = ActiveDocument.Sections.Count
'
' Find Current Section Break (i.e., nearest BELOW Cursor)
Call FindSectionBreakNext
'
' Copy it
Selection.Copy
'
' Get Current Section Number
With Selection
.Collapse Direction:=wdCollapseEnd
SectNum = .Information(wdActiveEndSectionNumber)
End With
'
' we're now in NEXT Section - Is it the LAST Section?
If SectNum = LastSect Then
' YES - LAST Section - Reformat to match CURRENT
With Selection.PageSetup
.PaperSize = PSize
.LineNumbering.Active = LineNum
.Orientation = POrient
.TopMargin = TMar
.BottomMargin = BMar
.LeftMargin = LMar
.RightMargin = RMar
.Gutter = GMar
.HeaderDistance = HDist
.FooterDistance = FDist
.PageWidth = PWidth
.PageHeight = PHeight
.FirstPageTray = FirstTray
.OtherPagesTray = OtherTray
.SectionStart = SectType
.OddAndEvenPagesHeaderFooter = OddEven
.DifferentFirstPageHeaderFooter = DiffFirst
.VerticalAlignment = VAlign
.SuppressEndnotes = SupNotes
.MirrorMargins = MMar
.TwoPagesOnOne = TwoPage
.GutterPos = GPos
End With
'
' Link Header & Footer to Previous to copy CURRENT's Header & Footer
With ActiveDocument.Sections(SectNum)
.Headers(wdHeaderFooterPrimary).LinkToPrevious = True
.Footers(wdHeaderFooterPrimary).LinkToPrevious = True
End With
'
' Got Header & Footer from CURRENT - Now Unlink 'em per SOP
With ActiveDocument.Sections(SectNum)
.Headers(wdHeaderFooterPrimary).LinkToPrevious = False
.Footers(wdHeaderFooterPrimary).LinkToPrevious = False
End With
Else
' NO - NOT LAST Section - Find NEXT Section Break
Call FindSectionBreakNext
'
' Paste Current Section Break over it
Selection.Paste
'
' Pasting Section Break moved Cursor DOWN off of it - Go find it again
ABOVE you
Call FindSectionBreakPrev
End If
'
' Go back to Original Current Section Break and delete it!
Call DeleteSectionBreakPrev
'
' ** END **
'
' End Sub ReplaceSectionBreakNext
End Sub
Sub FindSectionBreakNext()
'
' FindSectionBreakNext Macro
'
' (c) John A. Young, Jr.
'
' Finds NEXT Section Break BELOW current Cursor Location
' (i.e., At END of CURRENT Section)
'
' Declare & Define Variables
'
' Set Search Direction DOWN (i.e., Forward)
DirFlag$ = "Down"
'
' ** START **
'
' Search for Next Section Break
Call FindSectionBreak_x(DirFlag$)
'
' ** END **
'
' End Sub FindSectionBreakNext
End Sub
Sub FindSectionBreakPrev()
'
' FindSectionBreakPrev Macro
'
' (c) John A. Young, Jr.
'
' Finds PREVIOUS Section Break ABOVE current Cursor Location
' (i.e., At END of PREVIOUS Section)
'
' Declare & Define Variables
'
' Set Search Direction UP (i.e., Backward = NOT Forward)
DirFlag$ = "Up"
'
' ** START **
'
' Search for Previous Section Break
Call FindSectionBreak_x(DirFlag$)
'
' ** END **
'
' End Sub FindSectionBreakPrev
End Sub
Sub DeleteSectionBreakPrev()
'
' DeleteSectionBreakPrev Macro
'
' (c) John A. Young, Jr.
'
' Deletes PREVIOUS Section Break ABOVE current Cursor Location
' (i.e., At END of the Previous Section)
' NOTE: Deleting the PREVIOUS Section Break merges the PREVIOUS Section with
' the CURRENT Section, thus changing the PREVIOUS Section to match the
' CURRENT Section's Page Format!
' Shortcut Key : None
' Menu Text = Merge PREVIOUS Section into CURRENT
' Menu Image = MergeNextButton.bmp
'
' Declare & Define Variables
'
' ** START **
'
' Search for Previous Section Break
Call FindSectionBreakPrev
'
' Delete it!
Selection.Delete
'
' ** END **
'
' End Sub DeleteSectionBreakPrev
End Sub
Sub FindSectionBreak_x(DirFlag$)
'
' FindSectionBreak_x Macro
'
' (c) John A. Young, Jr.
'
' Finds Nearest Section Break based on Direction argument DirFlag$ where:
' DirFlag$ = "Down" => Direction is DOWN (i.e., Forward = True)
' (OR)
' DirFlag$ = "Up" => Direction is UP (i.e., NOT Forward => False)
'
' Declare & Define Variables
'
Down$ = "Down" ' Search Forward for CURRENT Section Break
Up$ = "Up" ' Search Backward for PREVIOUS Section Break
'
' ** START **
'
Application.ScreenUpdating = False
'
' Decode DirFlag$ into True or False and set Search Direction accordingly
If LCase(DirFlag$) = LCase(Up$) Then
Direction = False
Else
' If DirFlag$ not UP, ALWAYS assume DOWN!
Direction = True
End If
'
' Are we in Main Document Window or Header/Footer?
If Selection.Information(wdInHeaderFooter) Then
' YES - In Header/Footer - Can't search for Section Break - Notify User!
Sp11$ = Space(11) ' Add 8 spaces for 'centering'
Sp32$ = Space(32) ' Add 28 spaces for 'centering'
ErrMsg1$ = Sp32$ & "NOTICE!"
ErrMsg2$ = "Can't search for Section/Page Break while in
Header/Footer!"
ErrMsg3$ = Sp11$ & "Close Header/Footer Window and try again!"
ErrMsg$ = ErrMsg1$ & vbCr & ErrMsg2$ & vbCr & ErrMsg3$
ErrStyle = vbExclamation
ErrTitle$ = "FindSectionBreak_x Macro"
ErrMsgBox = MsgBox(ErrMsg$, ErrStyle, ErrTitle$)
End
End If
'
' OK - In Main Doc Window - Search Direction for nearest Section Break
'
' MUST Collapse Selection before starting Search!
Selection.Collapse Direction:=wdCollapseStart
'
With Selection.Find
.Text = "^b"
.ClearFormatting
.Format = False
.Forward = Direction ' True = Down / False = Up
.Wrap = wdFindStop
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute
' Did we find it?
If .Found Then
' YES - Found Section Break - Select it!
With Selection
.Find.Parent.Expand Unit:=wdParagraph
' .Delete Unit:=wdCharacter, Count:=1
End With
Else
' NO - Section Break NOT Found - Notify User & Quit!
' Determine if Section Break missing from 'Above' or 'Below'
If Direction = True Then
SearchDir$ = "BELOW"
Else
SearchDir$ = "ABOVE"
End If
' Build Error Message, Notify User and Quit!
Sp17$ = Space(17)
ErrMsg1$ = Sp17$ & "NOTICE!"
ErrMsg2$ = "No Section Break " & SearchDir$ & " Current Section!"
ErrMsg$ = ErrMsg1$ & vbCr & ErrMsg2$
ErrStyle = vbExclamation
ErrTitle$ = "FindSectionBreak_x Macro"
ErrMsgBox = MsgBox(ErrMsg$, ErrStyle, ErrTitle$)
End
End If
End With
'
' ** END **
'
' End Sub FindSectionBreak_x
End Sub
*** END CODE ***
If this does not solve your problem, e-mail me at (e-mail address removed).
John Young
