Добрый день! Не могу найти решение, помогите, пожалуйста. Суть в том, что в таблице (прилагается) есть столбец А (ФИО), в котором должны все буквы печататься ПРОПИСНЫМИ. Как сделать так, чтобы именно для столбца А включался Caps Lock?
Спасибо!
Добрый день! Не могу найти решение, помогите, пожалуйста. Суть в том, что в таблице (прилагается) есть столбец А (ФИО), в котором должны все буквы печататься ПРОПИСНЫМИ. Как сделать так, чтобы именно для столбца А включался Caps Lock?
Такой вариант. Поддерживает одновременный ввод в несколько несмежных ячеек (через Контрл+Ентер, например) [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) Dim d0_ As Range, d_ As Range Set d0_ = Intersect(Target, Range("A3").Resize(UsedRange.Rows.Count)) If d0_ Is Nothing Then Exit Sub Application.ScreenUpdating = 0 Application.EnableEvents = 0 For Each d_ In d0_ If d_ <> "" Then d_ = UCase(d_) End If Next d_ Application.EnableEvents = 1 Application.ScreenUpdating = 1 End Sub
[/vba]
Такой вариант. Поддерживает одновременный ввод в несколько несмежных ячеек (через Контрл+Ентер, например) [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) Dim d0_ As Range, d_ As Range Set d0_ = Intersect(Target, Range("A3").Resize(UsedRange.Rows.Count)) If d0_ Is Nothing Then Exit Sub Application.ScreenUpdating = 0 Application.EnableEvents = 0 For Each d_ In d0_ If d_ <> "" Then d_ = UCase(d_) End If Next d_ Application.EnableEvents = 1 Application.ScreenUpdating = 1 End Sub
#If VBA7 Then Private Declare PtrSafe Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer Private Declare PtrSafe Sub keybd_event Lib "user32" _ (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As LongPtr) #Else Private Declare Function GetKeyState Lib "user32.dll" (ByVal nVirtKey As Long) As Integer Private Declare Sub keybd_event Lib "user32.dll" _ (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long) #End If
Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.CountLarge > 1 Then If (GetKeyState(&H14) And &H1) = &H1 Then keybd_event &H14, 0, 0, 0 keybd_event &H14, 0, &H2, 0 End If Exit Sub End If 'здесь укажите номер столбца, для которого должен быть Caps Lock If Target.Column <> 1 Then If (GetKeyState(&H14) And &H1) = &H1 Then keybd_event &H14, 0, 0, 0 keybd_event &H14, 0, &H2, 0 End If Exit Sub End If If (GetKeyState(&H14) And &H1) <> &H1 Then keybd_event &H14, 0, 0, 0 keybd_event &H14, 0, &H2, 0 End If End Sub
[/vba]
Этот вариант нажимает/отжимает клавишу Caps Lock.
[vba]
Код
#If VBA7 Then Private Declare PtrSafe Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer Private Declare PtrSafe Sub keybd_event Lib "user32" _ (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As LongPtr) #Else Private Declare Function GetKeyState Lib "user32.dll" (ByVal nVirtKey As Long) As Integer Private Declare Sub keybd_event Lib "user32.dll" _ (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long) #End If
Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.CountLarge > 1 Then If (GetKeyState(&H14) And &H1) = &H1 Then keybd_event &H14, 0, 0, 0 keybd_event &H14, 0, &H2, 0 End If Exit Sub End If 'здесь укажите номер столбца, для которого должен быть Caps Lock If Target.Column <> 1 Then If (GetKeyState(&H14) And &H1) = &H1 Then keybd_event &H14, 0, 0, 0 keybd_event &H14, 0, &H2, 0 End If Exit Sub End If If (GetKeyState(&H14) And &H1) <> &H1 Then keybd_event &H14, 0, 0, 0 keybd_event &H14, 0, &H2, 0 End If End Sub
vitos88, добавил в пост 4 комментарий в код. В одной строке кода надо указать номер столбца, а именно здесь: [vba]
Код
If Target.Column <> 1 Then
[/vba] PS. Не цитируйте посты целиком. Чтобы ответить, не нужно щелкать кнопку "Цитата", а достаточно прокрутить страницу вниз и там будет поле для написания поста. Если хотите к кому-то обратиться, то просто напишите ник.
vitos88, добавил в пост 4 комментарий в код. В одной строке кода надо указать номер столбца, а именно здесь: [vba]
Код
If Target.Column <> 1 Then
[/vba] PS. Не цитируйте посты целиком. Чтобы ответить, не нужно щелкать кнопку "Цитата", а достаточно прокрутить страницу вниз и там будет поле для написания поста. Если хотите к кому-то обратиться, то просто напишите ник.Karataev
Сообщение отредактировал Karataev - Четверг, 21.09.2017, 11:57
_Boroda_, Новый день настал, появилась новая задача. Как в коде добавить ещё один произвольный столбец, например N, с такими же свойствами? Думаю, что его нужно где-то здесь указать: [vba]
Код
Set d0_ = Intersect(Target, Range("A3").Resize(UsedRange.Rows.Count))
[/vba]
_Boroda_, Новый день настал, появилась новая задача. Как в коде добавить ещё один произвольный столбец, например N, с такими же свойствами? Думаю, что его нужно где-то здесь указать: [vba]
Код
Set d0_ = Intersect(Target, Range("A3").Resize(UsedRange.Rows.Count))
Private Sub Worksheet_Change(ByVal Target As Range) Dim d0_ As Range, d_ As Range Set d0_ = Intersect(Target, Range("A:A,N:N")) If d0_ Is Nothing Then Exit Sub Application.ScreenUpdating = 0 Application.EnableEvents = 0 For Each d_ In d0_ If d_.Row > 2 Then If d_ <> "" Then d_ = UCase(d_) End If End If Next d_ Application.EnableEvents = 1 Application.ScreenUpdating = 1 End Sub
[/vba]
Неужели приведенный Вами выше кусок действительно работает так, как нужно?
Так например можно [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) Dim d0_ As Range, d_ As Range Set d0_ = Intersect(Target, Range("A:A,N:N")) If d0_ Is Nothing Then Exit Sub Application.ScreenUpdating = 0 Application.EnableEvents = 0 For Each d_ In d0_ If d_.Row > 2 Then If d_ <> "" Then d_ = UCase(d_) End If End If Next d_ Application.EnableEvents = 1 Application.ScreenUpdating = 1 End Sub
[/vba]
Неужели приведенный Вами выше кусок действительно работает так, как нужно?_Boroda_
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
