Страницы: 1
RSS
Можно ли изменить ширину выпадающего списка?
 
Имеется ячейка, в которую заносятся длинные названия, которые необходимо выбирать из определенного списка.  
 
Ширина ячейки небольшая, при выборе значения, слова в ячейке переносятся, ячейка растет в высоту.  
 
Но, ширина выпадающего списка равна ширине ячейки. При этом, если имеются названия начинающиеся одинаково, напрмер "Открытое акционерное общество...", понять, что находится в конце строки списка невозможно. И вся идея не работает.  
 
Можно ли изменить ширину выпадающего списка, сделать большей, чем ширина ячейки?
 
вопрос стабильно задается примерно раз в неделю, поищите поиском по сайту
 
пока не знаем как..  
 
есть два пути  
менять ширину ячейки(можно динамически)  
или  
создавать свой список на основе элемента управления
Живи и дай жить..
 
Option Explicit  
Private Sub Worksheet_SelectionChange(ByVal Target As Range)  
   Dim myShp As Shape, Drp As Single  
   Dim wks As Worksheet  
   Dim elmDic As Object  
   Dim elmShp As Shape  
   Dim drpShp As Shape  
   Dim objDic As Object  
   Dim a As Integer  
 
Set wks = Target.Parent  
'cells holding drop downs  
'If Intersect(Target, [A1:A5]) Is Nothing Then Exit Sub
On Error GoTo endfind  
If Target.Validation.InCellDropdown Then  
   Set objDic = CreateObject("Scripting.Dictionary")  
       For Each elmDic In wks.DrawingObjects  
           objDic.Add elmDic.Name, elmDic.Name  
       Next  
       For Each elmShp In wks.Shapes  
           If elmShp.Name Like "Drop Down *" Then  
               If Not objDic.Exists(elmShp.Name) Then  
                   Set myShp = elmShp  
                   Exit For  
               End If  
           End If  
       Next  
End If  
endfind:  
If myShp Is Nothing Then Exit Sub  
     
If myShp.Visible = msoTrue Then  
   Drp = myShp.Width - Target.Width  
'Column holding list, sized appropriately  
   myShp.Width = [D:D].Width
   myShp.Left = Target.Left - myShp.Width / 2 + Drp * 2  
   SendKeys "%{down}"  
End If  
 
Set myShp = Nothing  
End Sub
 
основная идея заключается в том что  
если ячейке назначена проверкаданных/список/допустимыезначения  
при активации ячейки ??НЕЧТО?? внутри экселя добавляет рядом с ячейкой значок выпадающего списка.  
Этот значок относиться к excel.shapes.  
Остаётся вычислить появился ли новый рисованный объект при активации ячейки.  
Сравниваем коллекцию sheet.DrawingObjects с коллекцией sheet.Shapes  
то чего нет в первой коллекции, но есть во второй и является значком открытия выпадающего спика проверки данных.  
К сожалению с ним мало что можно сделать средствами VBA, фактически можно только подвигать его по экрану, но это оказывается достаточно, чтоб изменить ширину выпадающего списка.  
 
Кроме этого есть проблема, что если повторно кликнуть по ячейке - активировать её ещё раз. Эта блин её shape обновляется, а событие selection_change не наступает, поэтому непосредственно в код добавлено  
SendKeys "%{down}"  
чтоб сразу же раскрыть выпадающий список проверки данных.  
 
кстати CellDropdown формально присутствует для всех ячеек, просто пока не назначена проверкаданных/список/допустимыезначения она невидима, Shp.Visible = msoFalse, поэтому присутствует строка If myShp.Visible = msoTrue Then, хотя здесь она вроде и не нужна из-за On Error GoTo endfind. Но если поставить On Error resume next, myShp будет находиться для любой активированной ячейки.  
 
p.s. Для того чтоб ухватить ??НЕЧТО??, реально за ноздрю, наверное нужно обращаться к программистам под windows.
 
Очень интересно. Большинство знатоков обычно всегда утверждало, что это невозможно :-(  
Однако, это работает!  
Чуть подполировал пример от ded luka.  
Интересно, нельзя ли примерно таким же образом регулировать ширину выпадающего списка автоподстановки и списка автофильтра? Тоже все обычно говорили, что невозможно... А вдруг...?
С уважением, Алексей (ИМХО: Excel-2003 - THE BEST!!!)
 
Уважаемые ded luka и Alex_ST! Объясните пожалуйста, почему макрос не работает на другом листе. Мои познания в VBA не позволяют мне это понять.
 
Уважаемые ded luka и Alex_ST! Объясните пожалуйста, почему макрос не работает на другом листе. Мои познания в VBA не позволяют мне это понять.
 
Этот код - для события листа (конкретного), записан в модуле листа.  
На другом листе в модуле этого кода нет - вот и не работает.
 
Большое спасибо за подсказку! Макрос отлично работает. Огромная благодарность разработчикам. Извините за наглость, но хочу спросить, нет ли подобного макроса для изменения ширины автофильтра?
Страницы: 1
Читают тему
Наверх