Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Прописные буквы без CAPS LOCK
 
#1
01.10.2016 10:23:09
Добрый день. Есть форма для печати в которую постоянно вводят данные. Можно сделать чтобы при любом вводе все буквы были прописные. Пример прикреплен. Заранее благодарю.
 
 
 
#2
01.10.2016 10:30:45
Можно вводить любыми, а по завершении ввода преобразовывать в прописные
В модуль листа
Код
?
1
2
3
4
5
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("A4, B6, C2, B8")) Is Nothing Then
        Target = UCase(Target)
    End If
End Sub
Согласие есть продукт при полном непротивлении сторон
 
 
 
#3
01.10.2016 10:33:12
Вариант без применения макросов.
Отдельно форма для ввода данных, отдельно для печати. В форме для печати ссылки на вводимые данные:
=ПРОПИСН(C2)
 
 
 
#4
01.10.2016 10:39:07
в процессе ввода - нет
а по окончанию ввода - легко.
Код
?
1
2
3
4
5
6
Private Sub worksheet_change(ByVal Target As Range)
  If Target.Count > 1 Then Exit Sub
  Application.EnableEvents = False
  Target = UCase(Target)
  Application.EnableEvents = True
End Sub
это положите в модуль листа
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
 
 
#5
01.10.2016 10:39:57
Про =ПРОПИСН(C2) я знал, но отдельной формой вообще ни как. А вот с кодом все работает. Спасибо огромное за быстрый отклик))
 
 
 
#6
01.10.2016 10:42:43
Ігор Гончаренко, а есть код чтобы каждое слово начиналось с заглавной. Например: при вводе иванов а.а., Было Иванов А.А.. Все заглавные это супер, но если модно было бы доработать до совершенства)))???
 
 
 
#7
01.10.2016 10:43:11
Sanja, я обломился ячейки перечислить,
а у Вас нужно события запретить, а то это код включит "вечный двигатель"
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
 
 
#8
01.10.2016 10:48:14
Sanja при удалении текста в ячейки вылетает ошибка
Run-time error '13':  Type mismatch
 
 
 
#9
01.10.2016 10:53:46
Поставьте дополнительную проверку:
Код
?
1
If Target.Value<>"" Then UCase (Target.Value)
 
 
 
#10
01.10.2016 10:54:24
С рекомендациями и обработкой ошибок
Код
?
1
2
3
4
5
6
7
8
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("A4, B6, C2, B8")) Is Nothing Then
        On Error Resume Next
        Application.EnableEvents = False
        Target = UCase(Target)
        Application.EnableEvents = True
    End If
End Sub
Согласие есть продукт при полном непротивлении сторон
 
 
 
#11
01.10.2016 10:55:23
Ігор Гончаренко, Ваш код работает и при удалении ошибок не выдает.
Sanja, Ваш код работает. Спасибо. Буду применять.
 
 
 
#12
01.10.2016 11:22:32
Можно и CAPSLOCK нажимать при вводе
В основной модуль
Код
?
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Private Declare Function GetKeyboardState Lib "user32" (pbKeyState As Byte) As Long
Private Declare Function SetKeyboardState Lib "user32" (lppbKeyState As Byte) As Long
Public Function GetCapslock() As Boolean
    GetCapslock = CBool(GetKeyState(vbKeyCapital) And 1)
End Function
Public Sub SetCapslock(Value As Boolean)
    Call SetKeyState(vbKeyCapital, Value)
End Sub
Public Sub SetKeyState(intKey As Integer, fTurnOn As Boolean)
    Dim abytBuffer(0 To 255) As Byte
    GetKeyboardState abytBuffer(0)
    abytBuffer(intKey) = CByte(Abs(fTurnOn))
    SetKeyboardState abytBuffer(0)
End Sub
В модуль листа
Код
?
1
2
3
4
5
6
7
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Target, Range("A4, B6, C2")) Is Nothing Then
        SetCapslock True
    Else
        SetCapslock False
    End If
End Sub
ИСТОЧНИК
Согласие есть продукт при полном непротивлении сторон
 
 
 
#13
01.10.2016 11:40:14
Цитата
VB777 написал: Было бы Иванов А.А.. Все заглавные это супер, но если модно было бы доработать до совершенства.
В модуль листа
Код
?
1
2
3
4
5
6
7
8
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, [C2]) Is Nothing And Target.Count = 1 Then
        On Error Resume Next
        Application.EnableEvents = False
        Target = WorksheetFunction.Proper(Target)
        Application.EnableEvents = True
    End If
End Sub
Согласие есть продукт при полном непротивлении сторон
 
 
 
#14
01.10.2016 12:03:55
Sanja все супер. Ваш код работает на ура. Огромное спасибо.
 
 
 
Страницы: 1
Читают тему
Loading...