Try:
Code:
Sub Demo()
Application.ScreenUpdating = False
Dim i As Long
With ActiveDocument.Range.Find
.ClearFormatting
.Replacement.ClearFormatting
.Format = True
.Font.SmallCaps = True
.Replacement.Font.AllCaps = True
.Replacement.Font.SmallCaps = False
.Forward = True
.Wrap = wdFindStop
.MatchWildcards = True
.Text = "[A-Z]"
.Replacement.Text = "^&"
.Execute Replace:=wdReplaceAll
.MatchWildcards = False
.Text = ""
.Replacement.Text = ""
For i = 12 To 36
.Font.Size = i / 2
.Replacement.Font.Size = i / 2 - 2
.Execute Replace:=wdReplaceAll
Next
End With
Application.ScreenUpdating = True
End Sub
As coded, the macro will resize all lower-case small-caps text between 6pt & 18pt to all caps 2pt smaller. All upper-case small-caps text is retained as all caps at the original size.