Heading question

[Fuzzhead]

I have the following macro that I use after I have converted WordPerfect
documents to Word documents. It goes through and corrects the Headings. Many
of these Headings have more than one paragraph, so my question is there a way
to tie the formatting of the second and third paragraphs to that of the
Heading paragraph?


Set SearchRange = ActiveDocument.Range
SearchRange.TextRetrievalMode.IncludeFieldCodes = True
With SearchRange.Find
.Wrap = wdFindStop
.Format = True
.Text = "^dLISTNUM"
While .Execute
'Select Found Text
SearchRange.Select
'Avoid Style Collection Error If Number is 0
If SearchRange.Characters.Last.Previous.Text = "0" Then
SearchRange.Characters.Last.Previous.Text = "1"
End If

'Apply Heading Format To Whole Paragraph Using Found Text Number
Selection.Paragraphs(1).Style = ActiveDocument.Styles("Heading " _
& SearchRange.Characters.Last.Previous)
'Delete Found Text
SearchRange.Text = ""
'Reset Range For Next Search Area
SearchRange.SetRange Start:=SearchRange.End, _
End:=ActiveDocument.Range.End
Wend
End With

 

[fumei via OfficeKB.com]

I have the following macro that I use after I have converted WordPerfect
documents to Word documents. It goes through and corrects the Headings. Many
of these Headings have more than one paragraph, so my question is there a way
to tie the formatting of the second and third paragraphs to that of the
Heading paragraph?

Set SearchRange = ActiveDocument.Range
SearchRange.TextRetrievalMode.IncludeFieldCodes = True
With SearchRange.Find
.Wrap = wdFindStop
.Format = True
.Text = "^dLISTNUM"
While .Execute
'Select Found Text
SearchRange.Select
'Avoid Style Collection Error If Number is 0
If SearchRange.Characters.Last.Previous.Text = "0" Then
SearchRange.Characters.Last.Previous.Text = "1"
End If

'Apply Heading Format To Whole Paragraph Using Found Text Number
Selection.Paragraphs(1).Style = ActiveDocument.Styles("Heading " _
& SearchRange.Characters.Last.Previous)
'Delete Found Text
SearchRange.Text = ""
'Reset Range For Next Search Area
SearchRange.SetRange Start:=SearchRange.End, _
End:=ActiveDocument.Range.End
Wend
End With

I am not quite following some things. For example:

"> 'Avoid Style Collection Error If Number is 0

If SearchRange.Characters.Last.Previous.Text = "0" Then
SearchRange.Characters.Last.Previous.Text = "1"

This a test of actual text, and i am not following where this text is from.
The search is ^dListNum.

In any case, you do not need to do the resizing with SetRange. A Range
object .Find causes the Range object to resize to the .Found item. So when:

With SearchRange.Find
.Wrap = wdFindStop
.Format = True
.Text = "^dLISTNUM"

actually finds a hit, SearchRange itself is resized to that. You do not need
(most of the time) to do any actual Selecting. So:

SearchRange.Select

is likely not needed. I also am not quite following "whole paragrpah".

'Apply Heading Format To Whole Paragraph

Again, a Range.Find when it does a .Found (through .Execute) is resized to
that Range. So you can apply, or action whatever you want to that. All you
need to do is use .Execute as a true loop, and collapse the range object
after each iteration. Like this:

With SearchRange.Find
.Text = "^dLISTNUM"
Do While .Execute(Forward:=True) = True
' do what you want to the found range
' SearchRange.Style = whatever for example
SearchRange.Collapse Direction:=wdCollapseEnd
Loop
End With

What I am not following is what exactly is found when you search for
^dLISTNUM. Is it including those other paragraphs, or not. If it is not,
then you can exapand what IS found, to include the next two paragraphs.

 

[Fuzzhead]

How do I expand what IS found, to include the next paragraphs if they exist?

Fuzzhead

 

[Helmut Weber]

Hi Fuzzhead,

the basic thing is to check, whether an object is not nothing.
if "xxxxx" is in the last paragraph of the doc,
then the next paragraph would be nothing.

Sub Macro2()
Dim rDcm As Range
Set rDcm = ActiveDocument.Range
With rDcm.Find
.Text = "xxxxx"
.Execute
If Not (rDcm.Paragraphs.Last.Next Is Nothing) Then ' thats it
MsgBox "there is at least one paragraph more"
rDcm.End = rDcm.Paragraphs.Last.Next.Range.End
rDcm.Select
Stop ' for testing
Else
MsgBox "there is no more paragraph"
End If
End With
End Sub

I've included the possibility,
that you search for text which spans over
several paragraphs, therefore:
rDcm.Paragraphs.Last.Next
which would enable you to expand the searched for text
for something like:
"xxx" & chr(13) & "xxx" & chr(13) ....

HTH


--

Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

Vista Small Business, Office XP

 

[Fuzzhead]

Hi Helmut,

I’m not sure how to apply your macro to mine. Below is what I have that goes
through my document and converts the old outline numbering and style to the
new outline numbering and style. What I’m trying to do is that many of the
old outline numbering and style have multiple paragraphs. My macro only
corrects the first paragraph that has the text "^dLISTNUM" at the beginning.
I want the other paragraphs to have the same formatting as the first
paragraph.

Set SearchRange = ActiveDocument.Range
SearchRange.TextRetrievalMode.IncludeFieldCodes = True
With SearchRange.Find
.Text = "^dLISTNUM"
Do While .Execute(Forward:=True) = True
SearchRange.Select
'Avoid Style Collection Error If Number is 0
If SearchRange.Characters.Last.Previous.Text = "0" Then
SearchRange.Characters.Last.Previous.Text = "1"
End If
SearchRange.Style = ActiveDocument.Styles("Heading " _
& SearchRange.Characters.Last.Previous)
SearchRange.Text = ""
SearchRange.Collapse Direction:=wdCollapseEnd
Loop
End With

Fuzzhead

 

[Helmut Weber]

Hi Fuzzhead,

hard to say what goes wrong without testing material.
I was critized lately for not using the collapse-method,
which would have resulted in shorter code in the particular case.

Yes, right, but...

with just collapsing you'll never see to what part of the doc
the next execution of find will apply.

Therefore, in general, I prefer to keep perfect control over ranges.
So instead of
SearchRange.Collapse Direction:=wdCollapseEnd
i'd rather set the range to be searched for myself, like
SearchRange.start = SearchRange.end
SearchRange.end = activedocument.range.end
SearchRange.select ' for testing

HTH

--

Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

Vista Small Business, Office XP