Please help with looping a process

[Jason L]

Hi, I am working on a macro that finds each instance of a Heading 6, then
moves one line below that text to the formatted numbered list and sets the
numbered list to start at one. I am still new at this, so I am trying to
keep it simple (i.e. I am not sure how to tell it to look only for lists that
begin with 2,3,4,5, etc, but not 1). I want the code to repeat until all the
numbered lists following heading sixes are restarted. Here is the code I
have thus far (as you can probably tell, it's not working):


Const LookFor As String = "Recommendations:"
'
With ActiveDocument.Content.Find
.ClearFormatting
.Text = LookFor
With .Style = ActiveDocument.Styles("Heading 6")
End With

Do While .Execute
Selection.MoveDown Unit:=wdLine, Count:=1
With ListGalleries(wdOutlineNumberGallery).ListTemplates(4).ListLevels(1)
.NumberFormat = "%1."
.TrailingCharacter = wdTrailingTab
.NumberStyle = wdListNumberStyleArabic
.NumberPosition = InchesToPoints(0)
.Alignment = wdListLevelAlignLeft
.TextPosition = InchesToPoints(0)
.TabPosition = InchesToPoints(0#)
.ResetOnHigher = 0
.StartAt = 1
.LinkedStyle = "List Number"
End With

Loop

TIA - Jason

 

[Helmut Weber]

Hi Jason,
working with numbered lists is a horrible scenario!
In case it is always the same listtemplate and the same
listlevel, the following might help.
Beware of line breaks from the newsreader and adjust
listtemplates(x) and listlevel(x) according to your needs.
Sub Test601()
With Selection
.WholeStory
.ExtendMode = False
.Collapse
End With
With Selection.find
.Style = "Heading 6"
While .Execute
Selection.MoveDown unit:=wdLine
With
ListGalleries(wdOutlineNumberGallery).ListTemplates(2).ListLevels(1)
.StartAt = 1
End With
Selection.Range.ListFormat.ApplyListTemplate _

ListTemplate:=ListGalleries(wdOutlineNumberGallery).ListTemplates(2),
_
ContinuePreviousList:=False, _
ApplyTo:=wdListApplyToWholeList
Wend
End With
End Sub
---
Greetings from Bavaria, Germany
Helmut Weber, MVP
"red.sys" & chr(64) & "t-online.de"
Word XP, Win 98
http://word.mvps.org/

 

[Jason L]

Helmut,

Thanks for your assistance. For some reason when I run the macro, nothing
happens. As you can see, I customized your macro according to what I believe
are the list styles in my document:

Public Sub Test601()
With Selection
.WholeStory
.ExtendMode = True
.Collapse
End With
With Selection.Find
.Style = "Heading 6"
While .Execute
Selection.MoveDown unit:=wdLine, Count:=1
With ListGalleries(wdNumberGallery).ListTemplates(7).ListLevels(1)
.StartAt = 1
End With
Selection.Range.ListFormat.ApplyListTemplate _
ListTemplate:=ListGalleries(wdNumberGallery).ListTemplates(7),
ContinuePreviousList:=False, _
ApplyTo:=wdListApplyToWholeList

Wend
End With
End Sub

When I run the macro, the screen flickers but nothing happens. I made sure
it was running the macro by commenting out the collapse section, and when I
did that the screen didn't even flicker at that point.

I should add that previous to the above macro the text is formatted as a
numbered list via another macro that performs a find/replace. I wonder if
the reason the macro is not working is because the macro is looking for a lis
tgallery template and not a style. Here is the section of the macro that
changes the unformatted numbered text to a numbered list.

With Selection.Find
.Text = "(^13)[0-9]{1,}.[^32^s^t]@"
.Replacement.Text = "\1^+"
'.Replacement.Text = "^+"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With

Selection.Find.Execute Replace:=wdReplaceAll


Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.Style = ActiveDocument.Styles("List Number")

TIA,
Jaso

 

[Helmut Weber]

Hi Jason,
pretty pretty complicated. Applying a style like
"list number" doesn't create a numbered list,
in fact, it removes automatic numbering.
In case, there are numbers there, then the are
not the automatically created numbers.
I think what you want, is to search for a paragraph
formatted as heading 6, select the text from after
this heading to right before the next heading
or the docs end(?) and apply a list template
with property ContinuePreviousList:=False to
the selection. Like this:
---
Public Sub Test601()
Dim r As Range
ResetSearch
With Selection
.WholeStory
.ExtendMode = False
.Collapse
End With
With Selection.Find
.Style = "Heading 6"
' .Style = "Überschrift 6" ' german
While .Execute
Selection.Bookmarks("\headinglevel").Select
Set r = Selection.Range
r.start = r.start + Len(r.Paragraphs(1).Range.Text)
r.Select
Selection.Range.ListFormat.ApplyListTemplate _
ListTemplate:=ListGalleries(wdNumberGallery). _
ListTemplates(2), _
ContinuePreviousList:=False, _
ApplyTo:=wdListApplyToWholeList
Selection.Collapse Direction:=wdCollapseEnd
Wend
End With
ResetSearch
End Sub
' which listtemplate to apply is up to you
Public Sub ResetSearch()
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute
End With
End Sub
If you got manually inserted numbers, they will
stay in addition to the automatically created
numbers. So they have to be removed before or after.
Keep on!

 

[Jason L]

Helmut,

It almost works now. You mentioned that the renumbering continued until the
end of the doc or the next heading level, well, there is more text in between
each header that does not need numbering. When I run the current macro, all
the text in between is getting numbered and it doesn't need to be. Is there
a way to just select until the end of that particular numbered list? If this
way too complicated, the good news is that the text between each numbered
section usually has a manual heading of some sort with no specific style
attached to it.

Here's an example:

Recommendations:
1) Revise the electrical system to provide power for the new hvac systems.
Computer room power should be connected to the generator backup system.
2) Replace light fixtures as required.
(Something like this text occurs at the end of each numbered list - i
could apply a style to it-------------------------> 3)TOTAL
ELECTRICAL COST: $95,000
(This sometimes begins a new section, so I could add a heading style to
it)---------------> Discipline: Asbestos
(This begins a new section as well and could get a heading style - it's not
supposed to be numbered either)--------> 5)Discussion:

The following three lines are actually supposed to be numbered, so they are
just fine for the most part.
6) Some pipe insulation contains asbestos.
7) Boiler gaskets may contain asbestos.
8) Some floor tile contains asbestos.

I hope this makes sense.

Thanks for your help.

-Jason

 

[Helmut Weber]

Hi Jason,

the text between each numbered section usually has
a manual heading of some sort with no specific style
attached to it.

well, it is awful. I can't think of a _not_ specific style.
There is always a style. But you could remove automatic numbering
from paragraphs, if there was a way, to identify them.
Maybe the are of style "standard".
Pseudocode:
For each paragraph whose style is standard
paragraph.Range.ListFormat.RemoveNumbers NumberType:=wdNumberParagraph
---
If you decided, not to remove the manual numbering before
applying the automatic numbering,
than you could remove the automatic numbering from all paragraphs,
that do not start with a number, and remove the manual numbering
from the paragraphs that are doubly numbered afterwards.
---
Keep on.
Greetings from Bavaria, Germany
Helmut Weber, MVP
"red.sys" & chr(64) & "t-online.de"
Word XP, Win 98
http://word.mvps.org/

 

[Jason L]

Helmut,

Check it out. I just found this code at the MVP site and it looks like it
will do what I want, BUT I need to add some lines that automatically find or
go to the numbered lists. What do you think?
Sub ListNumber()
With Selection.Paragraphs
.Style = "List Number"
With .First.Range.ListFormat
.ApplyListTemplate .ListTemplate, False
End With
With .Last
.KeepWithNext = False
.SpaceAfter = 10
End With
End With
End Sub

Tia,
Jason