Finding blocks of text with the same style

[djcamo]

Hi there,

I have a document that consists of a number of reports all formatted
in a similar way. Each report contains a block of text in a particular
style. What I am trying to do is find each block of text of that
particular style and add it to a collection to be used elsewhere.

I initially used soft returns for this block of text so that it was
one paragraph as far as Word was concerned and worked ok by scrolling
thru each paragraph and adding to the collection if it matched the
style.

Now this is not possible as the block of text requires bullets etc
which use hard returns.

What I want to do is to find the first line of this block of text, add
it to a temp string, check the next line and if it is the same style
append it to the temp string, else if it is not the same style then
take the temp string and add it to the collection, and then go to the
next block.

I hope this makes sense.

Cheers
DC

 

[Tony Jollans]

You can still run through each paragraph if you want (although using Find
would have been better) but if it's important that you combine consecutive
paragraphs in your Collection you'll need to add some extra code. This is
one way:

Dim Coll As Collection
Dim Mem

Dim SaveStart As Long
Dim SaveEnd As Long

Set Coll = New Collection
SaveStart = -1
SaveEnd = -1

With ActiveDocument.Content.Find

.Style = ActiveDocument.Styles("Your Style Here")
.Text = ""

Do While .Execute
If .Parent.Start <> SaveEnd Then
If SaveStart >= 0 Then
Coll.Add ActiveDocument.Range(SaveStart,
SaveEnd).FormattedText
End If
SaveStart = .Parent.Start
End If
SaveEnd = .Parent.End
Loop
If SaveStart >= 0 Then
Coll.Add ActiveDocument.Range(SaveStart, SaveEnd).FormattedText
End If

End With

 

[djcamo]

You can still run through each paragraph if you want (although using Find
would have been better) but if it's important that you combine consecutive
paragraphs in your Collection you'll need to add some extra code. This is
one way:

    Dim Coll As Collection
    Dim Mem

    Dim SaveStart As Long
    Dim SaveEnd As Long

    Set Coll = New Collection
    SaveStart = -1
    SaveEnd = -1

    With ActiveDocument.Content.Find

        .Style = ActiveDocument.Styles("Your Style Here")
        .Text = ""

        Do While .Execute
            If .Parent.Start <> SaveEnd Then
                If SaveStart >= 0 Then
                    Coll.Add ActiveDocument.Range(SaveStart,
SaveEnd).FormattedText
                End If
                SaveStart = .Parent.Start
            End If
            SaveEnd = .Parent.End
        Loop
        If SaveStart >= 0 Then
            Coll.Add ActiveDocument.Range(SaveStart, SaveEnd)..FormattedText
        End If

    End With

--
Enjoy,
Tony












- Show quoted text -

Thanks very much Tony