I give up!

[Fred Goldman]

Ok, I've been working almost forever on this code, but I can't get it to
work. What I'm trying to do is copy all the text between each heading (which
is tagged with a paragraph style named "Parsha") create a new document and
paste the text into the new document. Then loop it through all the headings.
Where I keep running into a problem is when it selects text that has more
than one style it gets confused with the Do Until statement. I think the
solution is to use the Range object, but I'm not familiar enough with it to
figure out how to use it. Here's the code:

Dim myPara As Style
Dim myLastStyle As Style
Dim x As Long
Dim myTemplate As String
x = 1
myTemplate = "C:\Templates\Chatzros Kadshechu.dot"
Set myLastStyle = ActiveDocument.Styles("Ha'aros")
Set myPara = ActiveDocument.Styles("Parsha")
Do
Do
Selection.MoveDown Unit:=wdParagraph, Count:=1, Extend:=wdExtend
Loop Until 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

 

[Andra]

Sub ng()

Set myPara = ActiveDocument.Styles("Plain Text")
Set myLastStyle = ActiveDocument.Styles("Date")

Do While Selection.Style <> myLastStyle
'either position the cursor in the doc so that there is a para with the
style myLastStyle
' after it, or change this line (or whatever) not to loop endlessly

st = Selection.Paragraphs(1)

Do
Selection.MoveDown Unit:=wdParagraph, Count:=1
Loop Until (Selection.Style = myPara Or Selection.Style = myLastStyle)

en = Selection.Paragraphs(1)

Set aRange = ActiveDocument.Range(Start:=st.Start, End:=en.Start)
aRange.Select

Selection.MoveDown Unit:=wdParagraph, Count:=1

Loop

End Sub


Fred Goldman wrote

 

[Helmut Weber]

Hi Fred,

an example for using ranges,
to get text _between_ two occurances
of a paragraph style:

Sub Test1000()
Dim rDcm As Range
Dim rTmp As Range
Set rDcm = ActiveDocument.Range
Set rTmp = ActiveDocument.Range
With rDcm.Find
.Style = "Aheading"
While .Execute
rTmp.start = rDcm.End
rDcm.start = rDcm.End ' = collapsing
If .Execute Then
rTmp.End = rDcm.start
rTmp.Select ' for testing
' Your code
rDcm.End = ActiveDocument.Range.End
End If
Wend
End With
End Sub