Hi Andreas,

Recursively halving the range until you don't get wdUndefined should be
pretty fast... See macros below.
Hope I got the logic right... you should run a few tests.

Regards,
Klaus

Sub SelectionFontSize()
 ' select some text and run this macro
 Dim rng As Range
 Dim min As Single
 Dim max As Single
 ' smallest possible size:
 max = 1
 ' largest possible size:
 min = 1638
 Set rng = Selection.Range.Duplicate
 Call MinMaxFontSize(rng, min, max)
 MsgBox min & "/" & max, , "min/max font size"
End Sub

Sub MinMaxFontSize(rng As Range, min As Single, max As Single)
 Dim myFontSize As Single
 Dim rng1 As Range
 Dim rng2 As Range
 myFontSize = rng.Font.Size
 If rng.Font.Size = wdUndefined Then
   Set rng1 = rng.Duplicate
   Set rng2 = rng.Duplicate
   rng1.End = rng.Start + Int(0.5 * (rng.End - rng.Start))
   rng2.Start = rng1.End + 1
   Call MinMaxFontSize(rng1, min, max)
   Call MinMaxFontSize(rng2, min, max)
 Else
   If myFontSize < min Then
   min = myFontSize
   Else
     If myFontSize > max Then
       max = myFontSize
     End If
   End If
 End If
End Sub