Styles help

[LEU]

I was working with Russ on this but I had a family emergency and gone for 5
days. I have the following macro but can’t get it to work right. When I run
the macro for example it converts "^dLISTNUM 24 \l 2" to the word "Heading
2". It doesn't see that as an Outline Number style and make it “1.2â€.

Dim SearchRange As Range
Set SearchRange = ActiveDocument.Range
SearchRange.TextRetrievalMode.IncludeFieldCodes = True
With SearchRange.Find
.Forward = True
.Wrap = wdFindStop
.ClearFormatting
.Format = True
.Text = "^dLISTNUM ^#^# \l ^#"
.Replacement.Text = ""
While .Execute
SearchRange.Text = "Heading " & SearchRange.Characters.Last.Previous
SearchRange.Select
Selection.Style = ActiveDocument.Styles("Heading " & _
SearchRange.Characters.Last)
SearchRange.SetRange Start:=SearchRange.End, _
End:=ActiveDocument.Range.End
Wend
End With


LEU

 

[Russ]

LEU,
You original macro was changing the found pattern to **styles** Heading 1,
Heading 2, etc.
That is what my macro did for you, too.

To also add numbering, try the 'two' lines below, inserted into macro where
I placed them. That new second line is actually one, long one.

I was working with Russ on this but I had a family emergency and gone for 5
days. I have the following macro but can¹t get it to work right. When I run
the macro for example it converts "^dLISTNUM 24 \l 2" to the word "Heading
2". It doesn't see that as an Outline Number style and make it ³1.2².

Dim SearchRange As Range
Set SearchRange = ActiveDocument.Range
SearchRange.TextRetrievalMode.IncludeFieldCodes = True
With SearchRange.Find
.Forward = True
.Wrap = wdFindStop
.ClearFormatting
.Format = True
.Text = "^dLISTNUM ^#^# \l ^#"
.Replacement.Text = ""
While .Execute
SearchRange.Text = "Heading " & SearchRange.Characters.Last.Previous
SearchRange.Select

ListGalleries(wdOutlineNumberGallery).ListTemplates(5).Name = ""
Selection.Range.ListFormat.ApplyListTemplate ListTemplate:=ListGalleries( _
wdOutlineNumberGallery).ListTemplates(5), ContinuePreviousList:=True, _
ApplyTo:=wdListApplyToWholeList, DefaultListBehavior:=2

 

[Russ]

LEU,
For your information, I recorded a macro while applying a certain style of
number list that I thought you wanted and then looked at that macro and
extracted the lines that I thought were most relevant to add to our ongoing
macro design. I did a short test on a test document and it seemed to work
OK.

 

[LEU]

Thank you for your help and time that you have spent on this.

I don’t think I am explaining myself very well. This is what my procedure
looks like:

1.0 PURPOSE

To provide instruction for flushing the lube oil system on RFW DT 1B and RFW
P 1B to ensure system cleanliness after overhaul.

2.0 REFERENCES

2.1 CVI 12 00,16, Delaval Manual

2.2 CVI 11A 00,70, Ingersoll Rand Manual

2.3 CVI 12 00,8, Vendor Drawing F 10885 (Unit Oil And Control Diagram)


This is what it looks like when I reveal the codes (Alt+F9):

{LISTNUM 24 \l 1}0 PURPOSE

To provide instruction for flushing the lube oil system on RFW DT 1B and RFW
P 1B to ensure system cleanliness after overhaul.

{LISTNUM 24 \l 1}0 REFERENCES

{LISTNUM 24 \l 2} CVI 12 00,16, Delaval Manual

{LISTNUM 24 \l 2} CVI 11A 00,70, Ingersoll Rand Manual

{LISTNUM 24 \l 2} CVI 12 00,8, Vendor Drawing F 10885 (Unit Oil And Control
Diagram)


This is what it looks like after I run the macro:

Heading 1PURPOSE

To provide instruction for flushing the lube oil system on RFW DT 1B and RFW
P 1B to ensure system cleanliness after overhaul.

Heading 1REFERENCES

Heading 2CVI 12 00,16, Delaval Manual

Heading 2CVI 11A 00,70, Ingersoll Rand Manual

Heading 2CVI 12 00,8, Vendor Drawing F 10885 (Unit Oil And Control Diagram)

Heading 1 should become Style Heading 1
Heading 2 should become Style Heading 2
Heading 3 should become Style Heading 3

I hope that this makes better sense.

LEU

 

[Russ]

LEU,
Yes, it was helpful to see what you were doing.
I was originally just adapting to the actions you were doing in the macro
you posted at the start.
I made some adjustments and added comments.
I hope this copies and pastes OK.
I tried to format this code with short lines.

Dim SearchRange As Range
Set SearchRange = ActiveDocument.Range
SearchRange.TextRetrievalMode.IncludeFieldCodes = True
With SearchRange.Find
.Forward = True
.Wrap = wdFindStop
.ClearFormatting
.Format = True
.Text = "^dLISTNUM ^#^# \l ^#"
.Replacement.Text = ""
While .Execute
'Select Found Text
SearchRange.Select

'Apply List Format To Selection
ListGalleries(wdOutlineNumberGallery).ListTemplates(5).Name = ""
Selection.Range.ListFormat.ApplyListTemplate _
ListTemplate:=ListGalleries(wdOutlineNumberGallery _
).ListTemplates(5), ContinuePreviousList:=True, _
ApplyTo:=wdListApplyToWholeList, DefaultListBehavior:=2

'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

 

[LEU]

Russ,

I tried this macro and it worked on the first procedure but would not work
on the second or third procedure I tried. It gives me the same error that the
requested member of the collection does not exist at the following spot in
the macro:

Selection.Paragraphs(1).Style = ActiveDocument.Styles("Heading " _
& SearchRange.Characters.Last.Previous)

Why it keeps hanging up there I don't know sense it worked great on the
first procedure(Very fast). I feel that I have taken up to much of your time
working on this. My orginal macro works but it just takes time to run. If
your ready to call it quits, thats fine with me.

LEU

 

[LEU]

Russ,

I got the macro to run if I did the following change to your macro:

MsgBox SearchRange.Characters.Last.Previous 'remove after testing

'Apply Heading Format To Whole Paragraph Using Found Text Number
Selection.Paragraphs(1).Style = ActiveDocument.Styles("Heading " _
& SearchRange.Characters.Last.Previous)

The message box comes up blank and I hit OK. The number is converted and it
goes to the next number and repeats itself all the way down through the
procedure converting the numbers.

LEU

 

[Russ]

LEU,
Your other 'procedures' probably have a different pattern when you reveal
the code, right?
The macro is set up to only find the pattern "^dLISTNUM ^#^# \l ^#" that you
were looking for in your original macro that you posted. The MsgBox test
line should not show a blank message, after finding the "^dLISTNUM ^#^# \l
^#" pattern.

I hope you know that it doesn't find any other pattern, but copies of this
macro could be made and altered to find them and then each changed copy
could be ran in succession to find a different pattern. But the heading
style number will probably be in a different part of the pattern and not the
next to the last character or as in this code .Characters.Last.Previous

It is looking for that single number in the pattern that determines the
heading level. If that number is a 0, VBA will complain at the style code
line that there is no Heading 0 in the Heading style collection. There are
only 1-9.
I suppose that if it found a 0, we could have the macro lie and say it was a
1 instead, if that is what you want.

I am not sure what you are saying in your last two messages. Below in your
last message, the code snippet looks like you just added the test line back
into the last version I posted to get it to work, which doesn't quite make
sense. You did use the last version, correct?, and you didn't change the
pattern it was looking for, did you?

 

[LEU]

Russ,

I other procedures have the same pattern. As long as I have the message box
in there and scroll down through the numbers one at a time the macro works.
If I take out the massage box I get the error I told you about in the
previous message. It does not make any sense to me why its not working.

LEU

 

[Russ]

LEU,
What number is in the MsgBox? Is it always a single number from 1 to 9?
If it is ever a 0, then the macro will cause an error because there is no
Heading 0 style.
This revision to the macro will avoid that error by changing the number from
a 0 to a 1.
If the MsgBox is blank then we are not picking up the number to use for the
Heading style.

Dim SearchRange As Range
Set SearchRange = ActiveDocument.Range
SearchRange.TextRetrievalMode.IncludeFieldCodes = True
With SearchRange.Find
.Wrap = wdFindStop
.Format = True
.Text = "^dLISTNUM ^#^# \l ^#"
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 List Format To Selection
ListGalleries(wdOutlineNumberGallery).ListTemplates(5).Name = ""
Selection.Range.ListFormat.ApplyListTemplate _
ListTemplate:=ListGalleries(wdOutlineNumberGallery _
).ListTemplates(5), ContinuePreviousList:=True, _
ApplyTo:=wdListApplyToWholeList, DefaultListBehavior:=2

'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

 

[LEU]

Russ,

The MsgBox is blank.

I put one in after "SearchRange.Select" and it found the number OK. But the
MsgBox after the following comes up blank:

Selection.Range.ListFormat.ApplyListTemplate _
ListTemplate:=ListGalleries(wdOutlineNumberGallery _
).ListTemplates(5), ContinuePreviousList:=True, _
ApplyTo:=wdListApplyToWholeList, DefaultListBehavior:=2

LEU

 

[Russ]

LEU,
Copy and paste this again.
It has two Msgboxes and they both give me the correct number.
So I'm not sure what is going on with your trials.

Dim SearchRange As Range
Set SearchRange = ActiveDocument.Range
SearchRange.TextRetrievalMode.IncludeFieldCodes = True
With SearchRange.Find
.Wrap = wdFindStop
.Format = True
.Text = "^dLISTNUM ^#^# \l ^#"
While .Execute
'Select Found Text
SearchRange.Select

'Delete Msgbox lines when done testing
MsgBox SearchRange.Characters.Last.Previous

'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 List Format To Selection
ListGalleries(wdOutlineNumberGallery).ListTemplates(5).Name = ""
Selection.Range.ListFormat.ApplyListTemplate _
ListTemplate:=ListGalleries(wdOutlineNumberGallery _
).ListTemplates(5), ContinuePreviousList:=True, _
ApplyTo:=wdListApplyToWholeList, DefaultListBehavior:=2

MsgBox SearchRange.Characters.Last.Previous

'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

 

[LEU]

Russ,

I tried your macro and it gives me a number in the first MsgBox and nothing
in the second Msgbox. I am using Word 2003. Could it be something in my
version of Word if you are using a different version?

LEU

 

[Russ]

LEU,
I'm testing on MacWord 2004 at home.

Copy and paste this again.
I put the heading formatting in front of the listnumber formatting.

Dim SearchRange As Range
Set SearchRange = ActiveDocument.Range
SearchRange.TextRetrievalMode.IncludeFieldCodes = True
With SearchRange.Find
.Wrap = wdFindStop
.Format = True
.Text = "^dLISTNUM ^#^# \l ^#"
While .Execute
'Select Found Text
SearchRange.Select

'Delete Msgbox lines when done testing
MsgBox SearchRange.Characters.Last.Previous

'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)

'Apply List Format To Selection
ListGalleries(wdOutlineNumberGallery).ListTemplates(5).Name = ""
Selection.Paragraphs(1).Range.ListFormat.ApplyListTemplate _
ListTemplate:=ListGalleries(wdOutlineNumberGallery _
).ListTemplates(5), ContinuePreviousList:=True, _
ApplyTo:=wdListApplyToWholeList, DefaultListBehavior:=2

'Delete Found Text
SearchRange.Text = ""

'Reset Range For Next Search Area
SearchRange.SetRange Start:=SearchRange.End, _
End:=ActiveDocument.Range.End
Wend
End With

 

[LEU]

Russ,

THAT DID IT. Thank you for all your help.

LEU

 

[Russ]

LEU,
You're welcome.
I learned some things, too!
The next thing we could have done was to store the style number in a
variable while it was stable, but that would have increased the number of
lines inside the loop, at a cost of speed.

 

[Russ]

LEU,
Speaking of the speed of the loop, it looks like the last line in the loop
is not needed to reset the search range. Sometimes it is needed to avoid
going into an infinite loop when using a 'While' loop, but it can be deleted
in this case. Maybe because we are deleting the found text, which is like
collapsing the found text, and have .Wrap = wdFindStop