Již dříve jsem zmínil vizi jediného „supercomba“ na listu, jehož obsah (seznam položek čerpaný z listu databanky) se mění v závislosti na sloupci, pro který má v danou chvíli sloužit. V tomto článku představím převážně funkční návrh.
![Univerzální ComboBox](https://sp-ao.shortpixel.ai/client/to_webp,q_glossy,ret_img,w_397,h_221/https://proexcel.cz/wp-content/uploads/excel-univerzalni-combobox.png)
Samozřejmě se neobejdeme bez maker VBA. Původní řešení jsem měl postavené na ovládacím prvku Formuláře, předělávka již využívá ovládací prvek ActiveX (ComboBox). Obě varianty mají své pro i proti, nicméně v prvku ActiveX lze kupříkladu nastavit velikost písma a alespoň částečně ovlivnit grafickou podobu. Poté, co si ComboBox vybereme na kartě Vývojář (pokud ji nevidíte, musíte ji přidat přes Soubor / Možnosti), nastavíme v Režimu návrhu požadované vlastnosti prvku (tlačítko Vlastnosti zobrazí dialog Properties). Teoreticky lze v seznamu ComboBoxu i vyhledávat, bohužel v kombinaci s užitou událostí klepnutí na prvek (Click) to v praxi nelze dost dobře realizovat. Zde je moje nastavení:
![Univerzální ComboBox - Properties](https://sp-ao.shortpixel.ai/client/to_webp,q_glossy,ret_img,w_807,h_941/https://proexcel.cz/wp-content/uploads/excel-univerzalni-combobox-properties.png)
Asi nejužitečnější je změna vlastnosti Style na fmStyleDropDownList. Prvek tak nebude umožňovat editaci textového pole nad seznamem. Škoda, že vlastnost ShowDropButtonWhen (skrytí tlačítka vpravo v textovém poli) Excel ignoruje. Následně doplníme procedury uvedené níže do modulu listu, kde je ComboBox aplikován a vypneme Režim návrhu.
Deklarační část modulu listu:
1 2 3 4 5 | 'zdroj dat Private Const cstrDatabanka = "Databanka" 'cíl Private Const cstrOblastPouziti As String = "B3:D22" |
Událostní procedura listu reagující na změnu výběru buněk:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 | Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim rngOblastPouziti As Range Dim rngVybranaOblast As Range Dim rngBunkaZobrazeni As Range Dim rngDataPrvniBunka As Range 'je zapnutý režim kopírování? If Application.CutCopyMode = xlCopy Then Exit Sub End If 'oblast použití Set rngOblastPouziti = Range(cstrOblastPouziti) 'kontrola výběru buněk (jednosloupcový výběr v oblasti použití) If Union(rngOblastPouziti, Target).Address = rngOblastPouziti.Address And _ Target.Columns.Count = 1 Then 'přiřazení vybrané oblasti do objektové proměnné Set rngVybranaOblast = Target.Areas(Target.Areas.Count) 's vybranou oblastí... With rngVybranaOblast 'umístění ovládacího prvku určuje buňka napravo 'od poslední přidané buňky ve výběru If ActiveCell.Address = .Cells(1).Address Then Set rngBunkaZobrazeni = .Cells(.Cells.Count)(1, 2) Else Set rngBunkaZobrazeni = .Cells(1)(1, 2) End If End With 's ovládacím prvkem... With Me.cboUniversal 'odstranění stávajících položek .Clear 'vyhledání buňky s první odpovídající položkou v databance Set rngDataPrvniBunka = _ Worksheets(cstrDatabanka).Range("1:1").Find( _ Cells(rngOblastPouziti.Offset(-1, _ 0).Row, ActiveCell.Column)).Offset(1, 0) 'naplnění ovládacího prvku položkami .List = Worksheets(cstrDatabanka).Range(rngDataPrvniBunka, _ rngDataPrvniBunka.End(xlDown)).Value 'umístění prvku (vpravo od poslední buňky výběru) .Top = rngBunkaZobrazeni.Top .Left = rngBunkaZobrazeni.Left End With 'zobrazení ovládacího prvku Me.cboUniversal.Visible = True Else 'skrytí ovládacího prvku Me.cboUniversal.Visible = False End If End Sub |
Událost SelectionChange má jednu nevýhodu. Jestliže chcete připojenou akci realizovat na stejné oblasti, musíte doslova použít Cimrmanův „krok stranou“ a vrátit se zpět.
Událostní procedura klepnutí na ovládací prvek (rovněž modul listu):
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 | Private Sub cboUniversal_Click() Dim rngBunka As Range Dim ref With cboUniversal 'pro neprázdný výběr buněk If (Selection.Cells.Count > 1) And (WorksheetFunction.CountA(Selection) _ > 0) Then 'dotaz na přepsání ref = MsgBox("Přepsat neprázdné buňky ve výběru (nelze vzít zpět)?", _ vbExclamation + vbYesNo + vbDefaultButton2) Select Case ref 'ano, přepsat stávající Case vbYes Selection.Cells = .List(.ListIndex) 'ne, ponechat stávající Case vbNo On Error Resume Next For Each rngBunka In Selection 'naplnit jen prázdné buňky If IsEmpty(rngBunka) Then rngBunka = .List(.ListIndex) Next rngBunka On Error GoTo 0 End Select Else 'naplnění prázdných buněk Selection.Cells = .List(.ListIndex) End If 'skrytí ovládacího prvku .Visible = False End With End Sub |
Řešení není nijak zvlášť „uhlazené“. Jednoduše musíme přetrpět některé nedodělky ovládacích prvků ActiveX a vystačit si s tím, co máme k dispozici. Jistě, nabízí se i varianta vlastního panelu s výběrovými seznamy, ať už zpracovaného přímo v Pásu karet, na vlastním Panelu nástrojů pod kartou Doplňky a nebo na formuláři UserForm. Ve větším měřítku, kdy je zdrojem databáze, stojí za to spustit Visual Studio (Community zdarma) a směřovat řešení i třeba do Podokna úloh.
Příloha:
univerzalni_combobox.zip