MS Word Macro to increment all numbers in word doc

问题:

I am trying to make a MS-word Macro to increment all numbers in the word document which are within brackets, eg original numbers [1] [2] [3] [4] , after incrementing all numbers by 10, above numbers will be changed to [11] [12] [13] [14]

I'm stuck in the code below and not familiar with VBA before. Can anyone suggest, what to add in code below to perform above macro??

Sub IncrementNumbers()
'
' IncrementNumbers Macro
'
'

Application.ScreenUpdating = False
Dim RngStory As Range, StrStart As String, StrEnd As String
StrStart = "["
StrEnd = "]"
Set RngStory = ActiveDocument.Range
With RngStory.Find

Some code here to increment and replace numbers

Set RngStory = Nothing
Application.ScreenUpdating = True
End Sub

回答1:

There is another option. I hope you are familiar with the concept of arrays (in any language). Just keep in mind that in VBA arrays are inside brackets ("[1]", "[2]"). If not, it won't be a problem.

If your goal is to replace [1] for [11], [2] for [12], ... [n] for [n+10] then you may do the following.

Please, consider to look here. The answers are alike. Changing numbering in word using VBA

The concept is to work with two arrays two times: I) replace [1] for @@@[1]@@@, [2] for @@@[2]@@@, ..., [n] for @@@[n]@@@; II) replace @@@[1]@@@ for [11], @@@[2]@@@ for [12], ..., @@@[n]@@@ for [n+10].

More profound view:

1.1) Create searchArray from [1] to [n]. You can use this. http://textmechanic.com/generate-list-numbers/. Prefix numbers with: "[", suffix with: "]", Join with: ",".

1.2) With the same tool create replaceArray with prefix "@@@" and sufix "@@@" (for uniqueness), i.e. @@@[1]@@@, @@@[2]@@@, .. @@@[n]@@@.

1.3) Replace searchArray for replaceArray.

[Adapt code from Annex].

2.1) Create searchArray, it is the same as in 1.2)

2.2) With the tool http://textmechanic.com/generate-list-numbers/ create replaceArray from [10] to [n+10]. I.e. [10], [11], ... [n]

2.3) Replace searchArray for replaceArray.

[Adapt code from Annex].

Annex

Option Explicit
Sub replaceArrayForArray()
'
'to create array use prefix\suffix and replacing tool http://textmechanic.com/
'
'
findArray = Array("[1]", "[2]", "[3]")
replArray = Array("@@@[1]@@@", "@@@[2]@@@", "@@@[3]@@@")

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: Why not replace [1] for [11]? But we have to firstly replace [1] for @[1]@ and then secondly @[1]@ for [11]?

Because in 10 iterations through loop we will have two [11] that will both turn into [21]; then three [21] that will turn into [31] etc.

PPS: Both parts of the code if you'd like to copy and paste the answer: http://codepad.org/sZEG78ak. But still you will have to expand arrays as noted above.