Macro Majuscule

Sub Majuscules()
Dim Table() As String
    Dim Cellule As Range, Plage As Range
    Dim sStr As String, sRes As String
    Dim Cmpt As Long, Ptr As Long
   On Error Resume Next
    Set Plage = Application.InputBox( _
            "Sélectionner la plage à couvrir", _
            "Plage:", _
            ActiveWindow.Selection.Address(0, 0), _
            Type:=8)
    If Err <> 0 Then
     On Error GoTo 0
     Exit Sub
    End If
    If Not (Plage Is Nothing) Then
        For Each Cellule In Plage
            sStr = UCase(Left(Cellule.Value, 1)) & _
                    LCase(Mid(Cellule.Value, 2))
            Ptr = Len(sStr)
            For Cmpt = 1 To Ptr
                sRes = Mid(sStr, Cmpt, 1)
                If (sRes = Chr(10)) Then
                    sStr = (Mid(sStr, 1, Cmpt)) & _
                            UCase(Mid(sStr, Cmpt + 1, 1)) & _
                            Mid(sStr, Cmpt + 2)
                End If
            Next Cmpt
            Cellule.Value = sStr
        Next Cellule
    End If
End Sub