Does A "Delete Section" Macro Already Exist?

Hi,
I'm looking for a macro that deletes the current section in a multi-section
document, and that fixes the header and footer problem that occurs when
deleting section breaks. I wanted to find out if someone had a macro out
there already before I tackled it myself.
TIA
MarieJ

Shauna
Fri Jan 11 17:36:10 PST 2008

Hi Marie

Strictly speaking, you can't delete a section. You can only delete its
.Range:

The section's .Range includes the section break at the end of the
section which holds the section's properties, including its headers and
footers. So, as an example, you could have a document with three
sections, the middle one of which is landscape. The following code would
delete the content within the second section and the section break
following it, leaving two sections, both portrait:

Sub DeleteSection2()

Dim oSec As Word.Section

Set oSec = ActiveDocument.Sections(2)
oSec.Range.Delete

End Sub

I'm not aware of "the header and footer problem that occurs when
deleting section breaks". I find Word's behaviour to be consistent: when
you delete the .Range of a section, Word deletes the section's headers
and footers, which is what I would expect.

If that does not suit your particular business needs, you may need to
make adjustments.

Hope this helps.

Shauna Kelly. Microsoft MVP.
http://www.shaunakelly.com/word




"MarieJ" <MarieJ@discussions.microsoft.com> wrote in message
news:0122DCD9-EF50-4B8E-8069-B5F8E612EABB@microsoft.com...
> Hi,
> I'm looking for a macro that deletes the current section in a
> multi-section
> document, and that fixes the header and footer problem that occurs
> when
> deleting section breaks. I wanted to find out if someone had a macro
> out
> there already before I tackled it myself.
> TIA
> MarieJ

jayoungjr
Wed Jan 16 20:06:00 PST 2008

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 jayoung@hal-pc.org.

John Young

--
jayoungjr


"MarieJ" wrote:

> Hi,
> I'm looking for a macro that deletes the current section in a multi-section
> document, and that fixes the header and footer problem that occurs when
> deleting section breaks. I wanted to find out if someone had a macro out
> there already before I tackled it myself.
> TIA
> MarieJ

StephenEnglish
Wed Mar 12 00:28:00 PDT 2008

Hi John
Fantastic code - thank you.
However, I had three bookmarks in the footer that I lost when I ran
ReplaceSectionBreakNext

I guess I need to copy those as well. It copied the text but not the
bookmarks.
Please do you have any clues for me?
Regards
Stephen

"jayoungjr" wrote:

> 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
> '