Preserve numbering when copying to a new document (MVP)

[Tim]

Hi there!

I need to copy paras formatted with styles containing outline numbering
(legal) to a new document and retain the numbering (using VBA)....

I seem to lose some of the numbering.

Ideas most welcome.

Thanks

Tim

 

[Helmut Weber]

Hi Tim,

Ideas most welcome.

"Any ideas, whatsover, most welcome" ;-)

would still have been better, as without sample documents
nothing but wild guesses can be offered.

As the numbering of autonumbered paragraphs is dependant of
their context, which is the actual document, copying them to
another document, deprives them of their context. I'd try
to get the liststring of the first listparagraph to be copied,
like
x = Selection.Range.ListParagraphs(1).Range.ListFormat.ListString

Set a bookmark at the position, where the insertion in the other
document will be done, insert, go to the bookmark,
and reset the start of numbering, like:

With ListGalleries(wdNumberGallery).ListTemplates(1).ListLevels(1)
.StartAt = x ' !!!
End With

ListGalleries(wdNumberGallery).ListTemplates(1).Name = ""
Selection.Range.ListFormat.ApplyListTemplate
ListTemplate:=ListGalleries( _
wdNumberGallery).ListTemplates(1), ContinuePreviousList:=False,
ApplyTo:= _
wdListApplyToWholeList,
DefaultListBehavior:=wdWord10ListBehavior

Whether ContinuePreviousList:=False or ContinuePreviousList:=true.
or any other optionas, serves your needs better, I don't know.
And all in all, handling autonumbered lists is about the most
complicated thing in Word, I'd say. Partially buggy, partially
undocumented, partially unfinished.

HTH

Greetings from Bavaria, Germany

Helmut Weber, MVP
"red.sys" & chr(64) & "t-online.de"
Word XP, Win 98
http://word.mvps.org/

 

[G.G.Yagoda]

Tim,

The problem is twofold: you must copy both the list template and the
outline-numbered styles.

For purposes of this macro you're in luck if you're using Word's
built-in Heading 1-9 styles to number both docs. If not, adjust the
code accordingly when you come to "Heading " & k.

Important: in both docs the level 1 outline-numbering style MUST be
linked to an outline-numbered list template. To do that, put your
cursor on the level 1 style, then > Modify > Format > Numbering. Go to
the Outline-Numbered Gallery if not there already. If the None window
is framed, you must click another window. Then click Customize. Only
the first level has to be linked to a style; the code links the rest.

There can be only two docs open in the active documents window - the
copied and the new doc. You may or may not encounter problems if the
new doc is a template.

I would be grateful if you could report back how the macro worked for
you.

Sub CopyListTemplateAndHeadingStyles()

Dim CopiedDoc As Document
Dim NewDoc As Document

Dim CopiedLT As ListTemplate
Dim NewLT As ListTemplate

Dim CopiedSty As Style
Dim NewSty As Style

Dim W As Window, L As ListTemplate, k As Byte

Set NewDoc = ActiveDocument
For Each W In Windows
If W.Document.Name <> NewDoc.Name Then Set CopiedDoc = W.Document
Next

'IN EACH DOC, FIND LIST TEMPLATE LINKED TO HEADING 1 STYLE
For Each L In CopiedDoc.ListTemplates
If L.ListLevels(1).LinkedStyle = "Heading 1" Then
Set CopiedLT = L
Exit For
End If
Next
For Each L In NewDoc.ListTemplates
If L.ListLevels(1).LinkedStyle = "Heading 1" Then
Set NewLT = L
Exit For
End If
Next

'COPY LIST TEMPLATE SETTINGS
For k = 1 To 9
With NewLT.ListLevels(k)
..Font.Bold = CopiedLT.ListLevels(k).Font.Bold
..Font.Italic = CopiedLT.ListLevels(k).Font.Italic
..Font.Underline = CopiedLT.ListLevels(k).Font.Underline
..Font.AllCaps = CopiedLT.ListLevels(k).Font.AllCaps
..Font.Size = CopiedLT.ListLevels(k).Font.Size
..NumberFormat = CopiedLT.ListLevels(k).NumberFormat
..NumberPosition = CopiedLT.ListLevels(k).NumberPosition
..NumberStyle = CopiedLT.ListLevels(k).NumberStyle
..TabPosition = CopiedLT.ListLevels(k).TabPosition
..NumberPosition = CopiedLT.ListLevels(k).NumberPosition
..TextPosition = CopiedLT.ListLevels(k).TextPosition
..TabPosition = CopiedLT.ListLevels(k).TabPosition
..TrailingCharacter = CopiedLT.ListLevels(k).TrailingCharacter
..LinkedStyle = NewDoc.Styles("Heading " & k)
End With
Next

'COPY HEADING STYLE ATTRIBUTES
For k = 1 To 9
Set CopiedSty = CopiedDoc.Styles("Heading " & k)
Set NewSty = NewDoc.Styles("Heading " & k)
With NewSty
..Font.Bold = CopiedSty.Font.Bold
..Font.Italic = CopiedSty.Font.Italic
..Font.AllCaps = CopiedSty.Font.AllCaps
..Font.SmallCaps = CopiedSty.Font.SmallCaps
..Font.Size = CopiedSty.Font.Size
..Font.Underline = CopiedSty.Font.Underline
..ParagraphFormat.Alignment =
CopiedSty.ParagraphFormat.Alignment
..ParagraphFormat.KeepWithNext =
CopiedSty.ParagraphFormat.KeepWithNext
End With
Next
End Sub

 

[Tim]

Thanks Gentlemen,

I will test the concepts today, unless we decide to do a save as...

Regrettably Mr Weber, The Word spellchecker was unable to recognise the word
"Whatsover" .... ; ) lol