Creating New Documents At Each Heading

Thread view:

Enable EMail Alerts

Start New Thread

Thread rating:

Fred Goldman - 03 Feb 2006 16:10 GMT

I'm trying to create a documents from all the text between each headin. For
example Heading1 after that is BodyText1 and BodyText2, create a single
document from that until the next Heading1 and so on.

Here's what I've got:

Dim myPara As Style
Dim myLastStyle As Style
Dim x As Long
Dim myTemplate As String
x = 1
myTemplate = Templates("C:\Templates\Chatzros Kadshechu.dot")
Set myLastStyle = ActiveDocument.Styles("LastParagraph")
Set myPara = ActiveDocument.Styles("Heading1")
Do
Do
Selection.MoveDown Unit:=wdParagraph, Count:=1, Extend:=wdExtend
'At the following line it chokes because it selects two
paragraphs
'which have two different styles
Loop While Selection.Style <> myPara
Selection.Copy
Documents.Add Template:=myTemplate
ActiveDocument.Range.PasteAndFormat wdFormatOriginalFormatting
ActiveDocument.SaveAs FileName:="D" & x
ActiveDocument.Close
x = x + 1
Selection.MoveDown Unit:=wdParagraph, Count:=1
Loop Until Selection.Style = myLastStyle
End Sub

Reply to this Message

Andra - 03 Feb 2006 18:14 GMT

did you see two replies to your 24jan message?

> I'm trying to create a documents from all the text between each headin. For
> example Heading1 after that is BodyText1 and BodyText2, create a single
[quoted text clipped - 26 lines]
> Loop Until Selection.Style = myLastStyle
> End Sub

Reply to this Message

Fred Goldman - 03 Feb 2006 18:37 GMT

Yeah, thanks for the replies, I tried both of them, and they didn't work
(same problem). I would've posted there, but I thought it was too old and
noone would be following it (you've got a good memory!).

> did you see two replies to your 24jan message?
>
[quoted text clipped - 30 lines]
> > Loop Until Selection.Style = myLastStyle
> > End Sub

Reply to this Message

Doug Robbins - Word MVP - 03 Feb 2006 21:41 GMT

The following will need a bit of customising to suit the exact name of your
Heading 1 style and also to use your template, but it does create a separate
document for each heading 1 in the original document with each new document
containing the heading 1 and the text that follows it before the next
heading 1

Dim myrange As Range, i As Long, newdoc As Document, j As Long
j = 1
Selection.HomeKey wdStory
Selection.Find.ClearFormatting
Selection.Find.Style = ActiveDocument.Styles( _
"Heading 1,Section,Main,h1,Heading1")
With Selection.Find
Do While .Execute(FindText:="", MatchWildcards:=False,
Wrap:=wdFindContinue, Forward:=True) = True
i = 1
Set myrange = Selection.Range
myrange.End = ActiveDocument.Range.End
Selection.Collapse wdCollapseEnd
For i = 2 To myrange.Paragraphs.Count
If myrange.Paragraphs(i).Style = ActiveDocument.Styles( _
"Heading 1,Section,Main,h1,Heading1") Then
Exit For
End If
Next i
myrange.End = myrange.Start + myrange.Paragraphs(i - 1).Range.End
Set newdoc = Documents.Add
newdoc.Range.FormattedText = myrange.FormattedText
newdoc.SaveAs "C:\aqs\newdoc" & j
newdoc.Close
j = j + 1
myrange.Cut
Loop
End With

Signature

Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP

> Yeah, thanks for the replies, I tried both of them, and they didn't work
> (same problem). I would've posted there, but I thought it was too old and
[quoted text clipped - 34 lines]
>> > Loop Until Selection.Style = myLastStyle
>> > End Sub

Reply to this Message

Fred Goldman - 06 Feb 2006 01:15 GMT

I can't figure out why this is happening. I have 62 headings and it is only
making 7 Documents and at random headings, no specific order. Any
suggestions? None of my styles have plus signs etc.

> The following will need a bit of customising to suit the exact name of your
> Heading 1 style and also to use your template, but it does create a separate
[quoted text clipped - 69 lines]
> >> > Loop Until Selection.Style = myLastStyle
> >> > End Sub

Reply to this Message

Fred Goldman - 06 Feb 2006 02:16 GMT

I am desperately trying to read this macro, but I'm too much of a novice to
understand what it says. However, this may help, some of the headings have
only one paragraph of text after them (not exclusively the ones that it's
skipping though), also the whole document is only one section.

> I can't figure out why this is happening. I have 62 headings and it is only
> making 7 Documents and at random headings, no specific order. Any
[quoted text clipped - 73 lines]
> > >> > Loop Until Selection.Style = myLastStyle
> > >> > End Sub

Reply to this Message

Doug Robbins - Word MVP - 06 Feb 2006 05:00 GMT

Neither of those things should make any difference, nor why you thought to
mention the plus signs. Does each "heading" have the same style applied to
it?

Signature

Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP

>I am desperately trying to read this macro, but I'm too much of a novice to
> understand what it says. However, this may help, some of the headings have
[quoted text clipped - 89 lines]
>> > >> > Loop Until Selection.Style = myLastStyle
>> > >> > End Sub

Reply to this Message

Fred Goldman - 06 Feb 2006 11:26 GMT

Yes, and I also tried changing all the headings to Heading 1 and ran the code
without making any changes with the same results.

> Neither of those things should make any difference, nor why you thought to
> mention the plus signs. Does each "heading" have the same style applied to
[quoted text clipped - 93 lines]
> >> > >> > Loop Until Selection.Style = myLastStyle
> >> > >> > End Sub

Reply to this Message

Fred Goldman - 06 Feb 2006 14:35 GMT

Ok, now I had a few paragraphs before the first heading (the title, author
etc.). I deleted those and now it goes through the first 18 without a problem
and then it starts skipping again.

Reply to this Message

Doug Robbins - Word MVP - 06 Feb 2006 21:29 GMT

Modify the definition of the Style so that it has a pagebreak before it and
then use the following macro:

Sub splitter()

'

' splitter Macro

' Macro created 16-08-98 by Doug Robbins to save each page of a document

' as a separate file with the name Page#.DOC

'

Dim Counter As Long, Source As Document, Target As Document

Set Source = ActiveDocument

Selection.HomeKey Unit:=wdStory

Pages = Source.BuiltInDocumentProperties(wdPropertyPages)

Counter = 0

While Counter < Pages

Counter = Counter + 1

DocName = "Page" & Format(Counter)

Source.Bookmarks("\Page").Range.Cut

Set Target = Documents.Add

Target.Range.Paste

Target.SaveAs FileName:=DocName

Target.Close

Wend

End Sub

Signature

Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP

> Ok, now I had a few paragraphs before the first heading (the title, author
> etc.). I deleted those and now it goes through the first 18 without a
[quoted text clipped - 110 lines]
>> >> > >> > Loop Until Selection.Style = myLastStyle
>> >> > >> > End Sub

Reply to this Message

Fred Goldman - 06 Feb 2006 23:50 GMT

Hah! All taken care of! I had two comments in the document. These must have
thrown the whole code off. Now it works like a charm. Thank you very much for
your help, Doug.

This will most likely be the last time I use comments. What a mess! I never
thought it would actually effect the main story, very interesting.

> Modify the definition of the Style so that it has a pagebreak before it and
> then use the following macro:
[quoted text clipped - 155 lines]
> >> >> > >> > Loop Until Selection.Style = myLastStyle
> >> >> > >> > End Sub

Reply to this Message