Sub DropCaps()
Dim oSection As Section
Dim i As Integer
    For Each oSection In ActiveDocument.Sections
        For i = 1 To oSection.Range.Paragraphs.Count
            If Len(oSection.Range.Paragraphs(i).Range) > 1 Then
                Exit For
            End If
        Next i
        With oSection.Range.Paragraphs(i).DropCap
            .Position = wdDropNormal
            .LinesToDrop = 2
            .DistanceFromText = CentimetersToPoints(0.1)
        End With
    Next oSection
    Set oSection = Nothing
End Sub