Macro for applying tagging

Question

For applying for a copyright, the Library of Congress wants your book (as a document) tagged with their coding. This involves placing the <ch1>, <ch2>, <ch3>, etc. tagging before each chapter. I'm creating a macro to apply all this coding automatically. Here is my code:

    Selection.Find.ClearFormatting

    Selection.Find.style = ActiveDocument.Styles("chapter number")

    With Selection.Find

        .Text = ""

        .Replacement.Text = ""

        .Forward = True

        .Wrap = wdFindAsk

        .Format = True

        .MatchCase = False

        .MatchWholeWord = False

        .MatchWildcards = False

        .MatchSoundsLike = False

        .MatchAllWordForms = False

    End With

    Selection.Find.Execute

    Selection.Copy

    Selection.PasteAndFormat (wdFormatOriginalFormatting)

    Selection.PasteAndFormat (wdFormatOriginalFormatting)

    Selection.HomeKey Unit:=wdLine

    Selection.MoveUp Unit:=wdParagraph, Count:=2

    Selection.TypeText Text:="<ch"

    Selection.MoveRight Unit:=wdWord, Count:=1

    Selection.TypeText Text:=">"

    Selection.MoveDown Unit:=wdParagraph, Count:=2

We have a style called "chapter number," so this code is finding the next instance of the "chapter number" style and inserting the <ch_> tag at the beginning. In the macro, I've repeated this code twenty times (since rarely do our books have more than 20 chapters). If there are less than 20 chapters, the following dialogue box appears at the end of the macro: "Word has reached the end of the document. Do you want to continue searching from the beginning?" I select "No," and then a Runtime Error 4605 dialog box appears.

Here's my question: Overall, the code works if I click through these dialog boxes at the end, but since others will be using this code, is there a way to simplify the code so that it doesn't require these extra clicks?

Answer 1

Use the following code:

Dim rng As Range

Selection.HomeKey wdStory

Selection.Find.ClearFormatting

With Selection.Find

Do While .Execute(findText:="[0-9]{1,}^13", _

MatchWildcards:=True, Wrap:=wdFindStop, Forward:=True) = True

With Selection

If .Style = "Chapter Number" Then

Set Rng = .Range

.Collapse wdCollapseEnd

With Rng

.End = .End - 1

.Text = "<" & .Text & ">" & vbCr & .Text

 End With

End If

End With

Loop

End With

Answer 2

You can do it without using a macro.

In the Find and Replace dialog, click on the More button and then with the selection in the Find what: control, use the Format drop down and select the Style item and then select your Chapter Number style and click on OK.   Then in the Replace with control, insert

<ch^&>^p^&

Then click on Replace All

Then do another Replace All, this time, inserting 

^p>

in the Find what control and insert

> 

in the Replace with control

Answer 3

Applying this tag is one among many elements in this macro. So ideally I'd like to get this into the macro so that it can all be done by the uninitiated Word user (the eventual user of this macro). Is there a way to get this into a macro, perhaps using the loop capability you mentioned?

Answer 4

BEFORE:

1 ["chapter number" style]

The Way Forward

In the beginning of the twelfth century . . . 

AFTER:

<ch1>

1

The Way Forward

In the beginning of the twelfth century . . .

Answer 5

Can you show a "before" and "after" of the change that you want the macro to make.

It will be possible to create a macro with one instance of the code that will "loop" throught the document to deal with any number of instances that need to be modified.