VBA to remove section breaks + other actions

[Rolsen]

Hi.

I have multiple word documents that I have to edit because the section breaks are messed up.

What I need to do is to:


Remove all section breaks
make a new section break before every heading 1
Insert a specifik header in each section

And if this could be achieved in multiple documents at once this would be amazing.

Any help would be very much appreciated.

Sorry for any incorrect spelling, English is not my native language.

Best Regards Rasmus

[gmaxey]

You can use my Batch Process Documents add-in http://gregmaxey.mvps.org/word_tip_pages/process_batch_folder_addin.html and the following user defined macro:


Function RedefineSections(ByRef oDoc As Word.Document) As Boolean
'See: http://gregmaxey.mvps.org/word_tip_pages/process_batch_folder_addin.html
'This procedure is a function that returns a Boolean data type.
'It contains a document object variable as a single parameter.
Dim oDoc As Word.Document
Dim oRng As Word.Range, oRngHeading As Word.Range
Dim oSec As Section
Dim bEOD As Boolean
Application.ScreenUpdating = False
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
Set oDoc = ActiveDocument
Set oRng = oDoc.Range
With oRng.Find
.Text = "^b"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceAll
End With
Set oRng = oDoc.Range
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With oRng.Find
.Format = True
.Style = ActiveDocument.Styles(wdStyleHeading1)
.Forward = True
.Wrap = wdFindStop
Do While .Execute
If oRng.End = oDoc.Range.End Then bEOD = True
Set oRngHeading = oRng.Duplicate
oRngHeading.Collapse wdCollapseStart
oRng.Collapse wdCollapseEnd
If oRngHeading.Start > 0 Then
Set oSec = oRngHeading.Sections.Add(oRngHeading, wdSectionBreakNextPage)
oSec.Headers(wdHeaderFooterPrimary).LinkToPrevious = False
oSec.Headers(wdHeaderFooterPrimary).Range.Text = oDoc.Sections.Count
If bEOD Then Exit Do
Else
oDoc.Sections(1).Headers(wdHeaderFooterPrimary).Range.Text = oDoc.Sections.Count
End If
Loop
End With
Application.ScreenUpdating = True
RedefineSections = True
lbl_Exit:
Exit Function
'It contains, as a minimum, a basic error handler.
'There is no code lines that attempt to save or close the document object.
Err_Handler:
RedefineSections = False
Resume lbl_Exit
End Function

[Rolsen]

Hi Greg.

Thanks for the reply, I finally got the time to try your add-in and code.
First when i copyed the code into the macro editor in Word, I couldn't see the macro in the index of macros.
Then I added 'sub name ()' and ended it at the bottom of the code.
Now I can see it but when I select the macro in your add-in I get an error - "Unable to exebute the process you defined. Ensure the procedure named "name" exists in the Normal template and try again."

What am I doing wrong?

[gmaxey]

Rolsen,

First, in the code that I sent to you, remove the line:

Dim oDoc As Word.Document


Then save the code in a standard module of your Normal template project.


Load my add-in and start it. Then for the macro you want to run select "user defined process" at the bottom of the dropdown list. Type in RedefineSections as the macro name.