Страницы: 1
RSS
Автоматическое раскрытие выпадающих списков в ячейке при её выделении., Макрос к выпадающим спискам в ячейках
 
Доброго времени суток. Уважаемые Гуру Excel, без Вашей помощи не обойтись перебрал (перечитал) много информации на различных форумах, но нужной не нашел...
Суть задачи. Необходим макрос, который бы автоматически раскрывал выпадающие списки в ячейках соответствующих таблиц на листе в книге при выделении (активации) таковых. Что бы не приходилось сначала выделить ячейку, а потом ещё нажать на кнопочку (справа) для раскрытия самого списка.

ЗЫ. Таблиц на листе в книге ооочень много и от постоянного кликанья мышкой по
ячейкам уже пальцы болят… :(

ЗЫ.2. Размерность таблиц не одинакова, столбцы с выпадающими списками находятся в разных столбцах листа:
Таблица1 -столбец B, Таблица2- столбец Е и тд. Все таблицы находятся на одном листе.

Файл с примером вложил
Изменено: altruist - 22.05.2019 11:58:08
 
altruist, из Вашего названия темы понятна проблема? Предложите новое - модераторы поменяют.
 
Если не правильно обозначил тему, извиняюсь. Попробую по-другому. Тема. Автоматическое раскрытие выпадающих списков в ячейке. Такая тема подойдет?
 
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Count = 1 Then
On Error GoTo Exi
If Target.Validation.Type = 3 And Target.Validation.InCellDropdown Then
        SendKeys "%{down}"
    End If
End If
Exi:
End Sub
По вопросам из тем форума, личку не читаю.
 
БМВ, Спасибо. Работает. Один минус только, видимо я забыл уточнить, выпадающие списки в таблицах существуют не только в одинарных ячейках, но и в объединенных (2-х или 3-х смежных по горизонтали). Ваше решение для объединенных ячеек не работает :(
 
Цитата
altruist написал:
видимо я забыл уточнить
Не видимо, а очевидно.
 
Попаразитирую на медвежьем коде
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    On Error GoTo Exi
    If Target(1).MergeArea.Validation.Type = 3 Then
        SendKeys "%{down}"
    End If
Exi:
End Sub
Изменено: _Boroda_ - 22.05.2019 13:31:23
Скажи мне, кудесник, любимец ба’гов...
 
_Boroda_, Александр,
Либо мой пример не подходит к коду, либо наоборот :-) (B3:B4 или E7:F7 объединил и не работает) , но меня больше смущает факт возможности выделить несколько ячеек. что тогда в этом случае. Если в первом отсекается сразу, то убрав If Target.Count = 1 Then чехарда получается. Но лучше выслушать ТС и его пример получить.
Изменено: БМВ - 22.05.2019 13:45:52
По вопросам из тем форума, личку не читаю.
 
караул! куда смотрят модераторы?
дожились - медведи уже кодят прямо на форуме, а потом на этом разводятся паразиты))
Изменено: Ігор Гончаренко - 22.05.2019 13:42:01
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Цитата
Ігор Гончаренко написал:
разводятся паразиты
если разводятся такие  Бородаторы , то норм :-)
По вопросам из тем форума, личку не читаю.
 
Не знаю, у меня вроде нормально работает
Вот файл
Изменено: _Boroda_ - 22.05.2019 14:37:53
Скажи мне, кудесник, любимец ба’гов...
 
Тут наткнулся, что есть разница в последовательности. Merge - Validation  и Validation - Merge. я использовал второе. G2 объединил с G3 и не работает.
По вопросам из тем форума, личку не читаю.
 
Тогда так
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    On Error GoTo Exi
    If Target(1).MergeArea(1).Validation.Type = 3 Then
        SendKeys "%{down}"
    End If
Exi:
End Sub
Убрал лишнюю строку (см. комментарии ниже)
Изменено: _Boroda_ - 22.05.2019 16:05:52
Скажи мне, кудесник, любимец ба’гов...
 
Цитата
_Boroda_ написал:
Тогда так
теперь ок. но Validation.InCellDropdown  я б оставил. Конечно редко кто снимает, но для универсальности лучше . А то получается что выпадает пустышка



Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    On Error GoTo Exi
   ' hh = Target(1).Address
    With Target(1).MergeArea(1).Validation
        If .Type = 3 And .InCellDropdown Then
            SendKeys "%{down}"
        End If
    End With
Exi:
End Sub


hh = Target(1).Address - от тестов осталось?
По вопросам из тем форума, личку не читаю.
 
Цитата
БМВ написал:
hh = Target(1).Address - от тестов осталось?
Ага. Спасибо, сейчас поправлю выше
Скажи мне, кудесник, любимец ба’гов...
 
Всем огромное человеческое спасибо. Последний код, написанный БМВ работает отлично. Именно то, что нужно.  
Страницы: 1
Наверх