Sub FontSizeMajor()
Dim oPar As Paragraph
Dim iType As Integer
Dim oWord As Range
Dim arrSizes(99)
Dim lngMax As Long, lngIndex As Long
  For iType = 1 To 2
    For Each oPar In ActiveDocument.StoryRanges(iType).Paragraphs
      If oPar.Range.Font.Size = wdUndefined Then
        For Each oWord In oPar.Range.Words
          arrSizes(oWord.Font.Size) = arrSizes(oWord.Font.Size) + 1
        Next oWord
        lngMax = GetMaxNumber(arrSizes)
        For lngIndex = 0 To 99
          If arrSizes(lngIndex) = lngMax Then
            oPar.Range.Font.Size = lngIndex
            Exit For
          End If
        Next lngIndex
       End If
     Erase arrSizes

     Next oPar
  Next iType
lbl_Exit:
  Exit Sub
End Sub
Public Function GetMaxNumber(ByRef strValues()) As Double
Dim i As Long
  For i = LBound(strValues) To UBound(strValues)
    If IsNumeric(strValues(i)) Then
      If CDbl(strValues(i)) > GetMaxNumber Then GetMaxNumber = CDbl(strValues(i))
    End If
  Next i
End Function