Outline Numbering Question

L

LEU

I have the following macro that converts my old outline numbering (from
WordPerfect) to our new numbering style. The problem is that not all the
procedures have the same old style numbering. Most I can convert using
"^dLISTNUM ^#^# \l 1" and so on. But I have come across a lot that are
“LISTNUM ParaNumbers1 \l 1†or “LISTNUM something elseâ€. Is there a way to
change my macro to catch all the different styles?


Dim SearchRange As Range
Dim HeadingRange As Range
Set SearchRange = ActiveDocument.Range
SearchRange.TextRetrievalMode.IncludeFieldCodes = True
With SearchRange.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "^dLISTNUM ^#^# \l 1"
.Replacement.Text = ""
.Replacement.Style = ActiveDocument.Styles("Heading 1")
.Forward = True
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceAll
.Replacement.ClearFormatting
.Format = False
.Execute Replace:=wdReplaceAll
End With
SearchRange.TextRetrievalMode.IncludeFieldCodes = True
With SearchRange.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "^dLISTNUM ^#^# \l 2"
.Replacement.Text = ""
.Replacement.Style = ActiveDocument.Styles("Heading 2")
.Forward = True
.Format = True
.Execute Replace:=wdReplaceAll
.Replacement.ClearFormatting
.Format = False
.Execute Replace:=wdReplaceAll
End With
SearchRange.TextRetrievalMode.IncludeFieldCodes = True
With SearchRange.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "^dLISTNUM ^#^# \l 3"
.Replacement.Text = ""
.Replacement.Style = ActiveDocument.Styles("Heading 3")
.Forward = True
.Format = True
.Execute Replace:=wdReplaceAll
.Replacement.ClearFormatting
.Format = False
.Execute Replace:=wdReplaceAll
End With
SearchRange.TextRetrievalMode.IncludeFieldCodes = True
With SearchRange.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "^dLISTNUM ^#^# \l 4"
.Replacement.Text = ""
.Replacement.Style = ActiveDocument.Styles("Heading 4")
.Forward = True
.Format = True
.Execute Replace:=wdReplaceAll
.Replacement.ClearFormatting
.Format = False
.Execute Replace:=wdReplaceAll
End With
SearchRange.TextRetrievalMode.IncludeFieldCodes = True
With SearchRange.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "^dLISTNUM ^#^# \l 5"
.Replacement.Text = ""
.Replacement.Style = ActiveDocument.Styles("Heading 5")
.Forward = True
.Format = True
.Execute Replace:=wdReplaceAll
.Replacement.ClearFormatting
.Format = False
.Execute Replace:=wdReplaceAll
End With
SearchRange.TextRetrievalMode.IncludeFieldCodes = True
With SearchRange.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "^dLISTNUM ^#^# \l 6"
.Replacement.Text = ""
.Replacement.Style = ActiveDocument.Styles("Heading 6")
.Forward = True
.Format = True
.Execute Replace:=wdReplaceAll
.Replacement.ClearFormatting
.Format = False
.Execute Replace:=wdReplaceAll
End With
SearchRange.TextRetrievalMode.IncludeFieldCodes = True
With SearchRange.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "^dLISTNUM ^#^# \l 7"
.Replacement.Text = ""
.Replacement.Style = ActiveDocument.Styles("Heading 7")
.Forward = True
.Format = True
.Execute Replace:=wdReplaceAll
.Replacement.ClearFormatting
.Format = False
.Execute Replace:=wdReplaceAll
End With
 
R

Russ

LEU,
You might use this to cover everything that your subroutine did.
Maybe it will give an idea on how to handle your other patterns.

Dim SearchRange As Range
Dim HeadingRange As Range
Set SearchRange = ActiveDocument.Range
SearchRange.TextRetrievalMode.IncludeFieldCodes = True
With SearchRange.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "^dLISTNUM ^#^# \l ^#"
.Replacement.Text = ""
.Replacement.Style = ActiveDocument.Styles("Heading " & _
SearchRange.Characters.Last)
.Forward = True
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceAll
End With
 
R

Russ

LEU,
The first subroutine I gave you might not change the Heading Style
correctly.
If not, try this one with a loop to help generate a new style each time.

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

LEU

Hi Russ,

I tried both of them and they did not work. They crashed at the following
point:

..Replacement.Style = ActiveDocument.Styles("Heading " & _
SearchRange.Characters.Last)

The error reads: The requested member of the collection does not exist.

LEU
 
R

Russ

LEU,
Try this one. A message box is included for testing.
It looks like styles require selection object to work, so I amended that.

Also our code didn't change the text, I added a line for that. I didn't know
how you wanted to handle that.

I tested without the field code and line break and it worked like I
expected it.

Also you know that a (space underscore) is used to break a long code line
that is normally one line?

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
MsgBox SearchRange.Characters.Last 'remove after testing
SearchRange.Text = "Test" & SearchRange.Characters.Last
SearchRange.Select
Selection.Style = ActiveDocument.Styles("Heading " & _
SearchRange.Characters.Last)
SearchRange.SetRange Start:=SearchRange.End, _
End:=ActiveDocument.Range.End
Wend
End With
 
R

Russ

Hi LEU,
That might be the ending field code, try changing first two .Last
to .Last.Previous or the first two .Last to .Last.Previous.Previous, etc.,
backing up until you see the number you expect in the found text.
For example:

Dim SearchRange As Range
Set SearchRange = ActiveDocument.Range
SearchRange.TextRetrievalMode.IncludeFieldCodes = True
With SearchRange.Find
.Forward = True
.Wrap = wdFindStop
.ClearFormatting
.Format = True
.Text = "LISTNUM ^#^#"
.Replacement.Text = ""
While .Execute
MsgBox SearchRange.Characters.Last.Previous
SearchRange.Text = "Chapter " & 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
 
R

Russ

LEU,
I accidentally left the wrong testing .Text = line in my last message.
Replace with your original pattern:
..Text = "^dLISTNUM ^#^# \l ^#"
 
L

LEU

Hi Russ,

Sorrry it took me until now to get back to you. I had a family emergency and
I just got back. I tried your macro and it picks up the last number now but
still does not work. When I run the macro for example it converts "^dLISTNUM
24 \l ^2" to the word "Heading 2". But it doesn't see that as a style.

LEU
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Change a great number of words in word files, with a macro as short as possible. 5
CleanUpPastedText() 1
Word macro that can call cells out of Excel for a find and replace 0
Need help modifying code 0
Tab problem 1
Word Macro for multiple searches, incl. in footnotes 2
Match style 0
VBA to look for more than 1 key word and highlights 8

Top