Автоматически изменять первую букву в слове на заглавную для Microsoft Office Excel.

[agregator]

Hugo121, спасибо перестало зацикливаться. Вот код

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Application.EnableEvents = False
Dim oCell As Range
For Each oCell In Target
On Error GoTo NoText
oCell = UCase(Left(oCell.Text, 1)) & _
Right(oCell.Text, Len(oCell.Text) - 1)
Next
Application.EnableEvents = True
Exit Sub
NoText:
End Sub

А чтобы увидеть как старый код зацикливался запиши этот

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim oCell As Range
MsgBox "Ещё раз!"
For Each oCell In Target
On Error GoTo NoText
oCell = UCase(Left(oCell.Text, 1)) & _
Right(oCell.Text, Len(oCell.Text) - 1)
Next
Exit Sub
NoText:
End Sub

[Anticoors]

=СЦЕПИТЬ(ЛЕВСИМВ(ПРОПНАЧ(A1);1);ПРАВСИМВ(A1;ДЛСТР(A1)-1))

У меня так работает. Автоматически заменяет первую букву в ячейке на заглавную.

[vikttur]

Как вариант:

=ПРОПИСН(ЛЕВСИМВ(A1))&ПСТР(A1;2;100)

для строки до 100 знаков.
Или

=ЗАМЕНИТЬ(A1;1;1;ПРОПНАЧ(ЛЕВСИМВ(A1)))

[fil_v]

Сообщение от vikttur

Как вариант:

=ПРОПИСН(ЛЕВСИМВ(A1))&ПСТР(A1;2;100)

для строки до 100 знаков.
Или

=ЗАМЕНИТЬ(A1;1;1;ПРОПНАЧ(ЛЕВСИМВ(A1)))

Скажите, а как сделать чтобы из предложения на всем листе (Microsoft Excel 2010), или на выделенной строке, столбце ТОЛЬКО первая буква ПЕРВОГО слова была заглавная.

Задача: Челябинский Трубный Завод
Цель: Челябинский трубный завод

[agregator]

Вот например выдели диапазон, запусти макрос и выбери букву "к"

Sub Замена_регистра()
Dim RgText As Range
Dim oCell As Range
Dim Ans As String
Dim strTest As String
Dim sCap As Integer, _
    lCap As Integer, _
    i As Integer
'// Предполагается, что перед вызовом макроса
'// пользователь выделил требуемый диапазон текста.
Again:
Ans = Application.InputBox("[С]трочные" & vbCr & "[П]РОПИСНЫЕ                   [З]аглавная первая" _
& 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)) & Right(oCell.Text, Len(oCell.Text) - 1)
        Case "К": oCell = UCase(Left(oCell.Text, 1)) & _
LCase(Right(oCell.Text, Len(oCell.Text) - 1))
        Case "Н": oCell = Application.WorksheetFunction.Proper( _
oCell.Text)
        Case "М"
                lCap = oCell.Characters(1, 1).Font.Size
                sCap = Int(lCap * 0.85)
'Малые прописные для всех букв.
                oCell.Font.Size = sCap
                oCell.Value = UCase(oCell.Text)
                strTest = oCell.Value
'Большие прописные для 1-х букв слов.
                strTest = Application.Proper(strTest)
                For i = 1 To Len(strTest)
                    If Mid(strTest, i, 1) = UCase(Mid(strTest, _
i, 1)) Then
                        oCell.Characters(i, 1).Font.Size = lCap
                    End If
                Next i
    End Select
Next
Exit Sub
NoText:
MsgBox "Текст в диапазоне " & Selection.Address & " отсутствует"
End Sub

[fil_v]

Сообщение от agregator

Вот например выдели диапазон, запусти макрос и выбери букву "к"

Sub Замена_регистра()
Dim RgText As Range
Dim oCell As Range
Dim Ans As String........

Благодарю Вас, помогло!!!

Я с такими командами первый раз работаю.
Скажите а как записать этот макрос в макросы Экселя? И чтоб потом его можно было запускать без окна Visual Basik? И еще, получается при таких командах шаг назад уже сделать нельзя? У меня стрелка шага назад неактивна.
Буду ОЧЕНЬ признателен, за пошаговую инструкцию.

[agregator]

fil_v , поместите прикрепленный файл в папку надстроек C:\Users\Ваш_пользователь\AppData\R oaming\Microsoft\AddIns
запустите Excel
выберите Сервис-Надстройки
поставьте галочку перед "Замена Регистра"
на стандартной панеле появится кнопка "Замена регистра"
нажимайте и пользуйтесь.
Про шаг назад здесь писали.

[fil_v]

Сообщение от agregator

fil_v , поместите прикрепленный файл в папку надстроек C:\Users\Ваш_пользователь\AppData\R oaming\Microsoft\AddIns
запустите Excel
....
Про шаг назад здесь писали.

Благодарю Вас! Все получилось!!!