Sub DropCaps()
Dim oSection As Section
Dim lngIndex As Integer
Dim oRng As Range
Dim strText As String
  For Each oSection In ActiveDocument.Sections
    For lngIndex = 1 To oSection.Range.Paragraphs.Count
      If Len(oSection.Range.Paragraphs(lngIndex).Range) > 1 Then
        Exit For
      End If
    Next lngIndex
    Set oRng = oSection.Range.Paragraphs(lngIndex).Range
    strText = oRng.Words(1).Text
    oRng.Collapse wdCollapseStart
    oRng.Select
    With oSection.Range.Paragraphs(lngIndex).DropCap
      .Position = wdDropNormal
      .LinesToDrop = 2
      .DistanceFromText = CentimetersToPoints(0.1)
    End With
    Selection.Paragraphs(1).Next.Range.Words(1).Delete
    Selection.Text = strText
    Selection.Characters.Last.Next.Delete
   Next oSection
    Set oSection = Nothing
End Sub