Changing numbering in word using VBA

问题

I have a document in which several questions are there. Now, there are couple of additions in the document. I have to now sit and change each and every question number. Also, There are certain skip pattern.

For example: "If 2 coded in Q5 then, go and ask Q6 else skip to Q10 "

Now, if I change the numbering of the questions. I becomes really difficult to map and change the routing questions.

Manually, It takes too much time. Please help me if there is any way through VBA or any method to minimize the manual work required.

回答1:

I guess your pattern is Q1, Q2, ... Qn representing Question 1, Question 2 etc.

Moreover, you have added Question 1, i.e. Q1. So former Q1 should turn into Q2, Q2 to Q3, ... Qn to Qn+1.

How to insert Q1 with incrementing all other Qs by one? The concept is the following.

1) Semi-automatically create a findArray and replaceArray.

How to create findArray: http://textmechanic.com/generate-list-numbers/. If you have 100 questions, generate numbers from 1 to 100, Prefix numbers with: "Q"; Join with: ",".

2) Bulk replace array ("Q1", "Q2", "Q3", ... "Q100") for array ("@@@Q1@@@", "@@@Q2@@@", "@@@Q3@@@", ... "@@@Q100@@@"). Loop through elements and change each findArray[i] for replaceArray[i]. [Adapt code from Annex]

3) Insert new Q1 in your text.

4) Bulk replace array ("@@@Q1@@@", "@@@Q2@@@", "@@@Q3@@@", ... "@@@Q100@@@") for array ("Q2", "Q3", "Q4", ... "Q101"). Create replace array with http://textmechanic.com/generate-list-numbers/. Loop through elements and change each findArray[i] for replaceArray[i]. [Adapt code from Annex]

That's it!

All that means that you should know how to change elements with the use of two arrays. Here is the code which works with three elements.

Annex

Option Explicit
Sub replaceArrayForArray()
'
'to create array use prefix\suffix and replacing tool http://textmechanic.com/
'
'
    findArray = Array("Q1", " Q2", " Q3")
    replArray = Array("@@@Q1@@@", "@@@Q2@@@", "@@@Q3@@@@")

    For i = 0 To UBound(findArray)
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = findArray(i)
        .Replacement.Text = replArray(i)
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute replace:=wdReplaceAll
    Next i
End Sub

PS: I use @@@ because it is rather rare.

PPS: Answer to the similar question: MS Word Macro to increment all numbers in word document

来源：https://stackoverflow.com/questions/29965120/changing-numbering-in-word-using-vba

标签

vba

word-vba