numericals in word macro - vba

Question

I have the task of finding numeric in a word document and alternatively superscript and subscript them.
I used this:
test = True
Dim chr As Range
For Each chr In ActiveDocument.Range.Characters
If IsNumeric(chr.Text) And test = True Then chr.Font.Subscript = True
test = False
If IsNumeric(chr.Text) And test = False Then chr.Font.Superscript = True
test = True
Next chr
This is only making all the numbers Superscript , not alternating between Super and Sub script
example Text -
" [17] Saied, M.H., Mostafa, M.Z., Abdel-Moneim, T.M., Yousef, H.A.: On Three Phase Six-
Switches Voltage Source Inverter: A 150° Conduction Mode. Member IEEE, Alexandria
Univercity (2006)"
now in tis example the macro would have to make 17 superscript and 150 subscript and 2006 as superscript..
Please someone help me with this

Answer 1

You could use Range.Characters to loop over the characters. Something like
Dim chr As Range
For Each chr In ActiveDocument.Range.Characters
If IsNumeric(chr.Text) Then chr.Font.SubScript = True
Next chr
Then add some booleans that tell you if you have to set it to sub- or superscript

Answer 2

if anyone needs the answer to this .. here is what I did ,
Selection.MoveUp Unit:=wdParagraph, Count:=2000
Dim vFindText As Variant
Dim vReplText As Variant
Dim i As Long
vFindText = Array("\[", "\] ", " \*")
vReplText = Array("", "", "")
With Selection
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Forward = True
.Wrap = wdFindStop
.MatchWholeWord = True
.MatchSoundsLike = False
.MatchAllWordForms = False
.MatchWildcards = True
.Format = True
.MatchCase = True
For i = 0 To UBound(vFindText)
.Text = vFindText(i)
.Replacement.Text = vReplText(i)
.Execute Replace:=wdReplaceAll
Next i
.Text = "[0-9]{1,}"
.Replacement.Text = "^&"
.Replacement.Font.Superscript = True
.Execute Replace:=wdReplaceAll, MatchWildcards:=True
End With
End With
MsgBox "Numbers has finshed , calling double1"
Call Numbers1
this will throw all numbers into subscript then it calls Sub Numbers1
Sub Numbers1()
Dim chr As Range
Dim firstChar As Word.Range
Dim test As Integer
test = 0
Dim firstAlphabet As Range
Selection.SetRange Start:=0, End:=100000
Set firstAlphabet = Selection.Range
For i = 2 To 1600
test = test + 2
Set firstChar = Selection.Characters(test)
If IsNumeric(firstChar.Text) Then firstChar.Font.Subscript = True
On Error Resume Next
Next i
End Sub
This will put all the numbers alternatively into subscript and superscript ....
The code can be optimized obviously ,,, at present it takes too long to do the given job ,,, but after searching for a working method all day, this is the only thing that works
hope this will help will Someone who comes finding this :)