Sub SetSmallCaps()

      ' Used to trap errors.
      On Error Resume Next
      Err.Clear

      ' Dimension the variables.
      Dim oTextRange As TextRange
      Dim oWordRange As TextRange
      Dim lNewFontSize As Long
      Dim i As Long

      ' Get reference to the selected text.
      Set oTextRange = ActiveWindow.Selection.TextRange

      ' See whether error occurred getting text selection.
      If Err.Number <> 0 Then

         MsgBox "Cannot apply Small Caps to selection. Please select " _
            & "some text and run the macro again.", vbExclamation, _
            "Invalid Selection"

         ' Stop the macro.
         End
      End If

      ' Loop through the words in the selection.
      For i = 1 To oTextRange.Paragraphs.Words.count

         ' Get a reference to the first word in the selection.
         Set oWordRange = oTextRange.Paragraphs.Words(i, 1)

         ' With oWordRange.Paragraphs.Characters(1, 1)
         With oWordRange.Characters(1, 1)

            ' Set the first letter to be upper case.
            .ChangeCase ppCaseUpper

            ' Calculate the new font size.
            lNewFontSize = ((.font.Size) / 1.3)

         End With

         ' Change the remaining characters to the new font size.
         With oWordRange
            .Characters(2, (oWordRange.Length)).font.Size = lNewFontSize
            .Characters(2, (oWordRange.Length)).ChangeCase ppCaseUpper
         End With

      Next i

   End Sub