Здравствуйте! Есть кнопка, которая должна менять регистр букв во всем столбце активной ячейки. Макрос где-то в интернете находил давно, но что-то пошло не так и он меняет регистр как надо, но только в активной ячейке, а не во всем столбце. В чем может быть проблема и как это исправить? [vba]
Код
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
[/vba]
Здравствуйте! Есть кнопка, которая должна менять регистр букв во всем столбце активной ячейки. Макрос где-то в интернете находил давно, но что-то пошло не так и он меняет регистр как надо, но только в активной ячейке, а не во всем столбце. В чем может быть проблема и как это исправить? [vba]
Код
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 & " Отсутствует"