Sub Замена_регистра () 
 
Dim RgText As Range, oCell As Range
Dim Ans As String, strTest As String
Dim sCap As Integer, lCap As Integer, i As Integer

Again:
Ans = Application.InputBox("[с]трочные" & vbCr & _
                           "[П]РОПИСНЫЕ" & vbCr & _
                           "[К]ак в предложениях" & vbCr & _
                           "[Н]ачинать Каждое Слово С Заглавных", "Введите букву [ ]", Type:=2)
If Ans = "False" Then Exit Sub
   If InStr(1, "СПКНМ", UCase(Ans), vbTextCompare) = 0 Or Len(Ans) > 1 Then GoTo Again
      On Error GoTo NoText
         If Selection.Count = 1 Then
            Set RgText = Selection
            Else
            Set RgText = Selection.SpecialCells(xlCellTypeConstants, 2)
         End If
On Error GoTo 0
  For Each oCell In RgText
    Select Case UCase(Ans)
           Case "С": oCell = LCase(oCell.Text)
           Case "П": oCell = UCase(oCell.Text)
           Case "К": oCell = UCase(Left(oCell.Text, 1)) & LCase(Right(oCell.Text, Len(oCell.Text) - 1))
           Case "Н": oCell = Application.WorksheetFunction.Proper(oCell.Text)
    End Select
  Next
Exit Sub

NoText: MsgBox "Текст в диапазоне " & Selection.Address & " отсутствует" 
 
End Sub