Graham,
I like your search string and I incorporated it into some code to change all
or selective change numbers. I am also posting some code for converting
plain numbers to ordinals:
Sub FormatOrdinalWithReview()
Dim oRng As Word.Range
Dim i As Long
Dim bNoReview As Boolean
bNoReview = True
If MsgBox("Do you want to review items before making changes?", vbQuestion +
vbYesNo, "Review") = vbYes Then
bNoReview = False
End If
i = ActiveDocument.Sections(1).Headers(1).Range.StoryType
For Each oRng In ActiveDocument.StoryRanges
Do
With oRng.Find
.Text = "[0-9][dhnrst]{2}"
.MatchWildcards = True
.Wrap = wdFindStop
.Forward = True
While .Execute
If bNoReview Then
oRng.Start = oRng.Start + 1
oRng.Font.Superscript = True
oRng.Collapse wdCollapseEnd
Else
oRng.Select
If MsgBox("Do you want to change this number", vbQuestion +
vbYesNo, "Change Number") = vbYes Then
oRng.Start = oRng.Start + 1
oRng.Font.Superscript = True
End If
oRng.Collapse wdCollapseEnd
End If
Wend
Set oRng = oRng.NextStoryRange
End With
Loop Until oRng Is Nothing
Next oRng
End Sub
Sub MakePlainNumberOrdinalNumbers()
Dim oRng As Word.Range
Dim i As Long
Dim x As Long
Dim bNoReview As Boolean
Dim bNotSpecial As Boolean
Dim pShortStr As String
bNoReview = True
If MsgBox("Do you want to review numbers before making changes?", vbQuestion
+ vbYesNo, "Review") = vbYes Then
bNoReview = False
End If
i = ActiveDocument.Sections(1).Headers(1).Range.StoryType
For Each oRng In ActiveDocument.StoryRanges
Do
With oRng.Find
.Text = "<[0-9]@>"
.MatchWildcards = True
.Wrap = wdFindStop
.Forward = True
While .Execute
bNotSpecial = True
If bNoReview Then
x = Len(oRng.Text)
If x = 2 Then
pShortStr = Right(oRng.Text, 2)
If pShortStr = "11" Or pShortStr = "12" Or pShortStr = "13" Then
ProcessoRng oRng, "th", 2
bNotSpecial = False
End If
End If
If bNotSpecial Then
Select Case oRng.Characters.Last.Text
Case Is = 1
ProcessoRng oRng, "st", x
Case Is = 2
ProcessoRng oRng, "nd", x
Case Is = 3
ProcessoRng oRng, "rd", x
Case Else
ProcessoRng oRng, "th", x
End Select
End If
Else
oRng.Select
If MsgBox("Do you want to change this number", vbQuestion +
vbYesNo, "Change Number") = vbYes Then
x = Len(oRng.Text)
If x = 2 Then
pShortStr = Right(oRng.Text, 2)
If pShortStr = "11" Or pShortStr = "12" Or pShortStr = "13"
Then
ProcessoRng oRng, "th", 2
bNotSpecial = False
End If
End If
If bNotSpecial Then
Select Case oRng.Characters.Last.Text
Case Is = 1
ProcessoRng oRng, "st", x
Case Is = 2
ProcessoRng oRng, "nd", x
Case Is = 3
ProcessoRng oRng, "rd", x
Case Else
ProcessoRng oRng, "th", x
End Select
End If
End If
oRng.Collapse wdCollapseEnd
End If
Wend
Set oRng = oRng.NextStoryRange
End With
Loop Until oRng Is Nothing
Next oRng
End Sub
Sub ProcessoRng(ByRef oRange As Range, pStr As String, i As Long)
With oRange
.Text = oRange.Text & pStr
.MoveStart wdCharacter, i
.Font.Superscript = True
.Collapse wdCollapseEnd
End With
End Sub
Graham said:
We'll have to guess about the rest of the macro, but for the matter
in hand
Dim oRng As Range
Selection.HomeKey wdStory
Selection.Find.ClearFormatting
With Selection.Find
Do While .Execute(findText:="[0-9][dhnrst]{2}", _
MatchWildcards:=True, _
Wrap:=wdFindStop, Forward:=True)
Set oRng = Selection.Range
oRng.Start = oRng.Start + 1
'oRng.Font.Superscript = True
oRng.Font.Subscript = True
Loop
End With
will work, though I suspect you meant 'superscript' which is the usual
format for ordinals.
Hi,
I want to modify my existing macro and so I can search all occurences
of 1st, 2nd, 3rd and replace them with 1st, 2nd and 3rd but only with
the st, nd and rd subscripted. How would I do that?
Thank you very much for your help.
